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HELP,  A  MULTI -MATERIAL  EULERIAN  PROGRAM  FOR  COMPRESSIBLE  FLUID 
AND  ELASTIC-PLASTIC  FLOWS  IN  TWO  SPACE  DIMENSIONS  AND  TIME 

VOLUME  II:  FORTRAN  LISTING  OF  HELP 


ABSTRACT 


Volume  II  is  a  complete  FORTRAN  IV  listing  of  the  HELP  program,  the 
background  description  of  which  is  contained  in  the  preceding  Volume  I. 


3SR-350 


The  language  used  in  the  following  version  of  the  HELP 
code  is  FORTRAN  IV  with  one  exception.  To  minimize  the  length 
of  the  listing,  the  common,  dimension  and  equivalence  state¬ 
ments  are  listed  only  once  at  the  beginning  and  are  assumed 
to  be  inserted  in  routines  in  place  of  the  nonstandard  state¬ 
ment,  INCLUDE  COMDIM.  This  program  has  been  run  on  the 
CDC-6600  as  well  as  the  UNIVAC-1108. 
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THIS  SECTION  IS  INSERTED  IN  EACH  ROUTINE  IN  PUCE  OF  INCLUDE  COMDIM 


D  1  HENS  1  nN 


l 


DIMENSION 


DIMENSION 


dimension 


DIMENSION 


1 

2 

3 

8 

5 

b 

7 

8 
9 


DIMENSION 


AMX ( 2SC0) . 

V  (  2500  » 

X 1 50 ) » 

DDXI  'j2>  , 

C  R  A  D  (  5  0  )  , 

Y ( 100) . 
OOY 1  |C2)  , 
SISC1 100)  , 

Pi.  (  200) 

SNB(SO) » 
VKI5C.3)  . 
SRR1SG.3). 
E«P ( 50,31. 

FRaCTp ( s  .  250  I  , 
7  Y ( 9  «  800 )  . 
PACT  1  3  .  10  >  » 
MPAC ( 3 ) . 

UUR ( 3 | , 

VOL  ( 3)  , 

A  M  0  M  (  3  )  » 
STE2I3) , 
SAMMY<3) , 
SDELEB 1 3 ) , 
SSISC ( 3 • 100) » 

value (81). 


41X12500  , 

P ( 2500  )  , 

X  X  I  52  I  , 

T  A  U  I  5  0  )  , 

PR ( SO ) 

YYl  102)  , 
FLEFT 1  IDO)  , 
GAMC 1 100 ) , 


S  T  B 1 50  )  , 
RHOC 1 50 ,31, 
SRZ (50,3)  , 
ERZ 1 50 , 3  I 

FRACRT19.250) , 
PRS  (  3 , 3  )  » 
PACT  1  3 , 1 0 )  , 
RH0JN13) i 
V  V  A  1  3  )  ■ 

K  S  0  R  (  3  ) 
RMU13) 

ST  K l (3> 

SDELM 1 3 ) 
SDELET ( 3  )  i 
NMP 1 8 ) 


U12500) , 


PK (15) 


2-STORAUE  euuivalences 


36 

. -  •  . 

common 

1 1  1) 

37 

i 

ICSTOP 

,  P  1 0  Y 

38 

.  2 

K  U  N  !  T  R 

.  IPR 

39 

3 

1  GM 

«  U N2  2 

80 

8 

UN  2  8 

,  UN29 

8  l 

5 

JMAX 

,  JMaXa 

82 

- . 6 

MAPS 

.NUMSCA 

83 

7 

IPCYCL 

, TSTOP 

98 

8 

N6 

,  R  T  M 

8  S 

9 

TOPM 

, BOTMU 

86 

COMMON 

C  Y  C  P  H  3 

87 

1 

ECK 

.  N  E  C  T  C  L 

83  - 

. . .  -  2 

I VaRdX 

,  T 

89 

3 

K 

.M 

50 

8 

UN97 

.  U  N  9  b 

61 

5 

E  ZPH  2 

, UNJ  OS 

52 

6 

UNI  |  < 

, UN  1  12 

53 

7 

NADD 

,  M  I  N  X 

.CYCLE 

,DT 

.NUMSP 

,  TOPMU 

,RTMU 

.UNI  l 

>  P  R  C  N  T 

.kunitw 

.XMAX 

.  UN 23 

,  DM  I  N 

i  UN  25 

.  NC 

,UN31 

.NRC 

i  K  M  A  X 

.  K  M  a  X  A 

,  B  0  T  M 

»PRL  IM 

. prdelt 

.  P  R  F  A  C  T 

.Y  FLAGF 

,*FLAGL 

.  U  N53 

.RTMV 

» UN5  9 

.N10 

i  U  N  6  5 

,  T  0  P  M  V 

.nsides 

.REZFCT 

.NTRACR 

.nmxcls 

, MTPMX 

.GLUED 

.UVMaX 

.EMIN 

.  PM  I  N 

. INTER 

»N 

,  U  N9  3 

.  U  N9  8 

.  UN9  9 

.EVAPM 

,  EV  APEN 

.UN  I 06 

.  UN i 0  7 

.UN  108 

.F INaL 

,  UN  I  18 

.MBBB 

.maxx 

,miny 

.maxy 

MFl AG  12500 ) 

DX15C)  » 
PROP  I  50  )  , 


DY  1  1 1)0  )  . 
Y A MC 1  100)  , 
Ul.  1  200). 


UK  1 50 ,3  )  , 
SZZ150.3)  , 
EZZ150.3I  , 


TX(8,8Q0)  , 
C  N  S  1  3 , 3  I  , 
MPA  CK 1 3 )  , 
SSIEN13)  , 

CS8R 1 3 ) , 

DELP 1 3 ) , 
CZERO 1 3 ) , 
STK213), 
SDELER ( 3 ) , 
SGAMC ( 3 ,100 ) , 


PM3  560 


.NFreLP 

,  NOUMP  7 

.flUMREZ 

,eth 

.  N  Z 

,NREZ 

.dTna 

,cv  IS 

t  l MAX 

,  IMaXA 

.  BQTHV 

, NUmS  P  t 

•  1 1 

.12 

, I VARDY 

.  V  T 

.Nil 

.GAMMA 

,  N  fl  A  T 

» C  Y  c  N  X 

.ground 

,  UN  7  5 

»ntcc 

,UN82 

.  I 

.  J 

,REZ 

.NODUhp 

.EVAPMU 

.EVaPMv 

■  UN  109 

.roeps 

.MSB 

,UNl  1  7 

,  iextx 

, JEXTY 
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c 


69 

fi  UN  125 

.  UN  1 2  4 

•  SSI 

•  SS2 

,  UM  1  N 

•  SSR 

.pRtime 

55 

9  EOR 

.EOT 

•  EOB 

,EMOR 

»OXF 

,0YF 

,  UN  l  38 

58 

COMMON 

STAB 

. x ienrg 

. XKENRfi 

1 X  TENRG  i 

, UNI  93 

.DTmIN 

57 

1  UN19S 

.EMOT 

. jcentr 

.Radius 

,68  AR 

,EHOb  , 

58 

C 

59 

c 

•  «•  dimensioned  arrays 

80  - 

-  c 

. 

~  •- 

_ • _ 

...  ... 

81 

1 

PK, 

62 

2 

W, 

XX  . 

63 

3 

oox , 

COY  , 

69 

9 

A  M  X  , 

A  1  X  , 

u, 

v,  1- 

P, 

mflag 

65 

S 

TAU, 

UL. 

PL’, 

66  - 

-  .... 

6 . . 

TX, 

TV,  . 

•  NMP  , 

.  RHOIN,- 

•  - . 

67 

7 

C7.ER0, 

STKl  , 

STKZ, 

STEZ, 

RMU, 

63 

8 

akom. 

SSIEN, 

UUR, 

V  V  A  ,  — ■ 

MPaCi 

MPACK 

69 

9 

pacx, 

PACT 

70 

c 

71 

c 

•«•  NON-OIMENSIONED 

variables 

72 

c 

73 

COMMON 

CTC, 

ENERGY  , 

ERDUMP,  13, 

IFSI  • 

1 FS2 , 

79 

1 

■  -  ka. 

KR  , 

ma.  mfk,  mo, 

MR, 

NeRR, 

7  S 

2 

NK.NVOID 

.  NPRlNT, 

NR, 

P1DTS, 

presur. 

Rhow. 

7  6 

3 

sdt  , 

SUM  , 

T60PI 

»  URR, 

VAbOVe  , 

*s , 

77 

9 

«SA  , 

WSB  , 

wsc , 

*sx , 

WSV  • 

last 

78 

c 

79 

c 

80 

COMMON 

/MXCELL/ 

SIEI3 

,250)  , 

XMASSI  3,250)  , 

RHO  I  9  , 

250), 

81 

1 

S AMP Y  1  3 

,250)  , 

SAMMP13.250)  , 

PL*  1  3 ) 

1 

82 

2 

RH02I30) , 

CNAUTI30)  , 

MAT ( 30  ) 

H  3 
89 
OS 


COMMON  /ELPL/  STRSZZ ( 2500 )  ,  sTRSRR  (  2S00J  ,  STRSRZI2500) 


86 

07  C 

8  8  C 

09  C 

90  C 

9 1  C 

92 

9  3 
99 

9S  C 

94 

97  C 

98  C 

99  C 

100  C 

101 
102 

103  C 

109  c 

ICS  c 

1  0  8 
107 


COMMON  /TRaCRS/  XP(IOOO),  ¥PC1000) 

••‘NOTE  THESE  MISCELLANEOUS  VARIABLES  ARE  DIMENSIONED 
FOR  A  GRID  WITH  3  MATERIAL  PACKA6ES  aNd  50  COLUMNS 
AND  100  ROWS. 

COMMON/M  ISC/  VLf3).XMAS(2,3),SSIEt2.3>,XRHC2,3>,PQI9,8), 

1  MFSREZ (150) ,REZAHX t ISO) .REZA1X  nsO)  , 

2  RCZXMS'3, 150)  ,  REZSIEI3.150I  ,  REZRHO C 9 , 1 50  ) 

EQUIVALENCE  (?( 1 ) ,PROB> 

•••  THF  FOLLOWING  EQUIVALENCES  MAKE  AVAILABLE 
XtM  .  T10)  •  DX(O)  ,  DYlO) 

EQUIVALENCE  (  X  X  (  2  )  ,  Xlin,  I  V  V  I  2  )  ,  Till) 

EQUIVALENCE  ( 0  0  X ( 2  •  ,  DX(l)),  (DDYI2),  dY(1>) 

•••  special  equivalences  for  cot  onlt 

EQUIVALENCE  (PL.OELP),  ( PL ( 8  )  i  DN  5 )  ,  t PL ( 2  I  )  , PRS >  ,  ( PL  I  38 )  . C SQR I  , 

1  (PL(92)  .VOI.)  ,  <PL(98I  ,WSQR) 
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08  C  '  ' 

08  C 

10  c  •••  special  ecu i valences  for  edit  and  map 

IS  c  " 

12  EQUIVALENCE  IUL.PR0P1,  (VALUE, PR, CRADI 

13  EQUIVALENCE  ( JCENTR, JPROJ) 

IN  C  ,  . 

15  C  SPECIAL  EQUIVALENCES  FOR  PH3  ONLY 

16  C 

17  EQUIVALENCE  (P.SNR),  (P(5)),STB),  I P ( 1 0 1)  ,  RHOC >  • 

10  I  <P(25| ) .UK.EHRI  i  (P(NOI 1 ,VK,EZZ>  ,  (P < 55 I  I  , ERZ I  , 

19  2  (PI70I ) ,SRZ> •  (P ( 8S 1 | , SRR  J  ,  (PllOOlliS ZZ> 

20  C 

21  C  SPECIAL  EQUIVALENCES  FOR  1NEACE 

22  C 

23  EQUIVALENCE  (P.FRACTP) ,  ipl 1D0I ) ,FRACRT) 

2  9  C 

25  C  •••  SPECIAL  EQUIVALENCES  FOR  PH2  ONLY 

26  C 

27  EQUIVALENCE  (UL.FLEFT), 

20  i  (PLtGAMCI  , 

29  2  (P.SOELET), 

30  3  (P ( 7 1 .SDELEB)  , 

31  9  (PI  13) , SAMMY!  , 

32  . S  (P(3UI  .SSI6CI 

33  C 

39  C  .  . . . . . 

35  C 

36  C  END  OF  COMMON 

37  C 

38  C  . . . 

39  C 

90  C 

91  ENC 

92  BLOCK  DATA 

93  C  •••  DEFINES  NORMAL  DENSITY  aND  SOUND  SPEED  COEFFICIENT 

99  c  fop  the  19  materials  listed  in  eqst. 

9  5  COMMON  /  M  X  C  F  l.  L  /  SIEI3.250)  ,  XHASS  (  3 , 250  I  ,  RHO(9,250|, 

96  1  SAMPY(3,250)  ,  S A M MP ( 3 , 2 50 )  ,  PL*(3).  - 

97  2  RHOZ  1 30 ) •  CN AUT ( 30  >  ,  ,  MATI30I 

98  DATA  (HHOZ (K  I  ,K»1  ,  1 9 ) 

99  1  / 19. 1 7 ,8.9,7,0,2,79, l .8, 9. 5, 8*9, 10.2, | | ,7. 

50  2  ;  11.3,  .9,  2.7,  2.7,  1.97,  1.7.  2.3,  2.8,  2.7,  2.2/ 

51  DATA  ICNAUT(K)  ,K*1  .19) 

52  1  / 9 . 0 1  PS .  3.9SE5,  9.Q3E5,  5.27E5,  8.06ES,  9.78E5. 

53  2  9 . 6  3  E  5 1  S.15ES,  2.13ES,  2.03E5.  2.89E5. 

59  3  2.58E5.  2.58E5,  2.29ES,  1.63E5,  3.99E5,  S.&iES, 

55  9  3.Q5E5.  3.37ES/ 

56  ENO 

57  SUBROUTINE  ADdTCR 

58  C  *»•  ADD  MATERIAL  tracer  PAPTICLES  in  A  SPECIFIED  region. 

59  INCLUDE  COMOIV 

60  C 

61  c  •*•••••♦•  find  TwF  area  in  WHICH  TRACERS  ARF  TO  BE  ADDED* 


(Ut  t 101  )  , Y AHC )  » 
IPL I  101 I.SIGCI . 
IP(9I , SDELER I , 
(PI  1.01  jSOELM,)  . 
(P( 16) , SGAMC ) . 
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162  t  -  . 

163  !F(N«DD.EQ*0)RETURN 

161  IFlHINX.LT. 1 ) Ht  N  X  > 1 

165  IF(MIt!X,6T.IMAX|HlNX«!M*X 

16*  1F1MINY.LT • | 1  H  I N  YM  i 

I*7  1F1MINY.GT.JHaXIMINY.JMAX 

168  1F1MAXX  .GT«  IHAX  I  HAXXMMAX  —  •  -  -- •- :  ■-  ---  —  r 

169  IF(MAXY.GT. JMAXIMAXY.JMAX 

170  6«ITE  l4,B|Nfl0P,**INX,MAXXtMlNY,HAXY  . 

>7*  8  FORMAT 1 / /39h  SUBROUTINE  ApoTCR  HAS  BEEN  CALLED. /»8h  NAdd*. 

l?2  | 1 H.7H  MlNX.,|3,7H  M A  X X" • l 3 • 7h  M f N Y« , I  3 , 7H  MAXY«,I3.//1 

173  XMIN-x (MlNX-l ) 

179  -  -  XXMA-X(MAXX)  . —  .....  -  -  .  . . - . .  . . . . 

175  YMINOY ( MlNY-l  ) 

176  YMAX«Y1MAXY) 

177  C 

178  C  •••*••♦••  DELETE  ANY  DUPLICATED  TRACER*;* 

179  C 

180  -  —  00  6  L*l  *NVo  10 . . .  . - . . -  - -  - 

181  NP«NMP<Ll 

182  1 F 1  HP • EE • l 1  GO  TO  6 

1 8  3  U»1 

I  8  9  1  TXTMPs1xlL.NI 

185  TYTMP.TYIL.N1 

186  .  2  N  •  N  M  . 

t  *7  IF  IABS1TXTMP-tXIL.N1 >,LE»0.»AND.ABs(TYTHP-Tr«L»Nl J.LE'0‘160  To  3 

1 88  IFIN.LT.NPlGO  TO  1 

189  GO  TO  4 

190  3  NPeNP- 1  . .  . . . 

191  NMF(L)»nP  ! 

1’2  (FIN.lE.  NP  •  GO  TO  9 

193  T  X  I  L  >  N | ■ 0 • 

198  TY1L.H1.0. 

1 95  GO  TO  6 

196  -  9  DO  S  M.N.NP 

197  TX1L.MI.TX1l, PM  1 

198  s  TYtL.Hl.TYlL.HM  1 

199  TX(L,MP*1  )»0. 

200  TYtL.hPM )«0. 

20  1  IF  I  N.LT.NP ) GO  TO  2 

202  6  CONTINUE 

203  C 

209  C  •»*••*••••  NADD.LT.O  INTERPOLATE  USING  CELL  COOROINATfS. 

205  c  . . ••  NADD.GT.O  interpolate  using  physical  COORDINATES. 

206  C 

207  ITFLAG.O 

208  IF1NA00.LT.01 ITFLAG.1 

209  IF  1  I  VARDX.EO.C* AND. I VARDY.EO.O) itfuag-i 

210  N  A  0  ■  I  A  B  S  I  fi  A  D  0  1 

211  DO  1 1 o  LPAS. 1,2  j 

212  oo  lor  l.n  1  *■  1  ,  MVO  ID 

213  nP.nhp  t  r;N  i  )  . 

219  IFIHP.LE.OIGO  TO  1 00 

215  TXSAV.TX INN) , | 1 


21*  TT5AV»TVINN1 , 1 ) 

217  PNSAV.l 

218  K I *0 

2  1  •  M  P  I.  U  5  ■  0 

220  00  90  | 3 1 SB 1 t  HP 

221  HH1-I3J5 

222  !PiNN|  .EO.NVOIO)  MM  1 -NR -MM l ♦ I 

223  MP«MMj*mPLOS 

221  k  2«k 1 

225  r.1-0 

22*  C 

227  C  •»••••♦••  DETERMINE  WHICH  CELL  TRACERS  LIE  IN. 

228  C 

229  ITP«tnT t  TX I NN ( »MP  1  I 

230  JTP-IMTCTYINMI  ,MP)  I 

231  C 

232  . . .  IF  THIS  CELL  IS  NOT  IN  THE  GRID,  GO  TO  So. 

233  C 

231  |FI| fP.GT. IMAX.OR.JTP.GT. JMAXlGO  TO  80 

235  C 

236  C  •«*••••••  MND  THE  PHYSICAL  CO-ORDINATES  OF  THE  TRACER. 

237  C 

238  XTX»XI ITP)*(TX(NN1 .MPI-FLOATI ITPl )*DXI ITP+I > 

239  TTY-Y I jTP)*l TVINN1 .MPl-FLOATI JTP) )«oT( JTP*1 ) 

210  TXT»TX (NNI  ,MP) 

211  TYT»TY(NN|  ,MP| 

212  C 

213  C  ••♦*•••••  IF  The  TRACER  IS  NOT  IN  THE  AREA  IN  WHICH  TRACERS 

211  C  «••*••••*  *Re  TO  BE  AODEO.  GO  TO  80. 

215  C 

216  IF  (  XT*  ,|_T  .XMtN.OR.XTX.GE.XXHA  7  GO  To  80 

217  IFIYTy.uT.TMIN.OR.YTY.GE.THAXIGO  TO  80 

218  K 1 • I 

219  C 

250  C  ♦••••*•*•  IF  The  PREVIOUS  TRACER  WAS  NOT  IN  THE  AREA,  GO  TO  70* 

251  IF<K2.EQ.0>  GO  TO  73 

252  C 

253  C 

251  C  ♦*•*«•••».  JF  TWO  CONSECUTIVE  TRACERS  aRE  BOTH  ON  THE 

255  c  *•♦*•«••••  A  X I S  f  no  NOT  INTERPOLATE  BETWEEN  THEM. 

25*  C 

257  |FI IXTX.LE.O..OR.TTY.LE.O. 1 .AND. (XTXI .LE*0..0R. YTYI ,LC»0, ) 1G0T070 

258  NAOO" I  NT (FLOAT < NTRACR ) ‘SORT  I  t TXT  1 -TXT ) •*2*l T YT 1-TYT ) **2 > I 

259  NAOO»MINO(NAOO*NAOl 

260  IF (NAOO.LE.O)GO  TO  70 

261  1F(LPaS.EQ.21*'PLUS*HPLUS^NAD0 

262  NNMP»NHP(NN| J*NAOO 

263  C 

26i  c  ••••••**•  if  there  is  no  more  room  for  ne*  tracers,  go  to  120. 

265  c 

266  IF (NNmP.GT.NTRMX >50  TO  120 

267  NMP ( NN |  | ■ N  N  M  P 

268  C 

269  C  ••••*••••  SHIFT  ALL  TRACERS  WHICH  F0L|_0#  Up  IN  THE  ARRaY 
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270  C  *••••«••*  N*00  PLACES. . 

271  C 

272  1FILPAS.NE.2IG0  TO  70 

223  DO  10  ]|l «HM 1 i NP 

27H  hT|»NmP(NnI >  *HM  1  -  l  It 

2 75  Ml2«MT 1 -N40D 

276  --  TX|MN|  ,mT|  >«TT(NN|  »MT2>  .  . .  -  -  - . 

277  IQ  TY(NN|  ,  M  T  l  ) .T Y ( NN I  *MT2J 

278  DO  60  |  I  1 ■ l  ,  N  A 0 D 

279  NT  1 »  J I | .NP- | 

280  IF| ITFLAO.EQ.l >60  To  SS 

281  C 

282  -  C  •••*••••*  FIND  THE  PHYSICAL  CO-ORDINATES  OF  The  NEW  TRACERS 

203  C  •••••••••  ft H I C H  are  TO  be  ADDED. 

289  C 

2B5  XADD-XTX1 ♦FLOaTI  ||  l  j*(XTX-XTXI J /FLOAT ( NADD+1 1 

286  VADO-YTT l+FLOAT ( I  II )*(YTY-VTY1 1 / FLOAT ( N ADO* I  I 

287  C 

?08  C  .........  fINO  AHlCh  CELL  THE  NEW  TRACERS  WILL  LIE  IN, 

289  C 

290  DO  20  | ■ I , I NA X 

291  1MXA0D.LT. 7  I  H  ISO  TO  30 

2 92  20  CONTINUE 

293  30  DO  HO  J. I , JHAX 

29H  IF( YAOO.lt. Y(J> ISO  TO  SO 

295  HO  CONTINUE 

296  C 

2 97  C  DETERMINE  Tx  AND  Ty  FOR  THE  NEW  TRACERS. 

298  C 

299  -  so  TX ( NN  |  ,  hT 1  > .FLOAT ( I  -  I) ♦ ( XAOD-X ( I  -  1 > ) /OX  I  I) 

300  TYINNI  ,mTI  >«FL0AT(J-1 )*<YADD-Y< J-l M/OYI J) 

301  60  TO  60 

302  C 

303  C  ••«*«*..••  FIND  CELL  COORDINATES  OF  NE*  TRACERS 

30R  c  «»••*••**•  j f  Interpolating  between  cell  coordinates. 

305  c 

306  SS  TXtNNl ,mT1 I ■ T X T I ♦ FLO A T I  I  I ll«(TXT«TXTI > /FLO AT t NADO*  1  , 

30  7  TTINNI  ,hT1  »«TYTI  ♦FLOAT  U  IIIMTYT.TYTI  I /FLOAT  (NADO*  I  1 

308  60  CONTINUE 

309  70  XTX1.XTX 

310  YTYI.YTT 

311  TXT1-TXT 

312  T  T  T I • T  T  T 

313  80  CONTINUE 

31 H  IF ( MM  |  .EQ.MMSAV 1  SO  TO  90  | 

31  S  IF( ABS(TXT-TXSAV> .LE.O..ANO.ABS|TYt-TYSAV).LE.O. IK1.-I 

3  16  IF  <  K  I  .SE.OI SO  TO  90 

317  Kl-0 

318  IFIMM1 .SE.NPlsO  TO  90 

319  C 

320  C  ..«♦•»«.•.  THIS  *AS  THE  LAST  POINT  OF  a  SUBPACKAGE.  FINO  THE 

321  C  COORDINATES  OF  THE  FIRST  POINT  OF  THC  NEXT  SUBPACKAGE. 

322  C 

323  MMSAV.HmI+1 
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32** 

325 

326 

327 

328 

329 

330 

331 

332 

333 

338 

335 

336 

337 
333 

339 
380 
381 

382 

383 
388 

385 

386 
387 
383 
389 

350 

351 

352 

353 
35-8 

355 

356 

357 

358 

359 

360 

361 
362 
363 
368 

365 

366 

367 

368 

369 

370 
37  1 

372 

373 
378 

375 

376 

377 


.  MTl»MHSAV**PLuS  . 

T*S*V»TXtNNl ,HTJ) 

TTSAV«TT<NNI ,MT1 I 
90  CONTINUE 

!F(LPAS.NE.2INMP(NNl l«NP 
100  CONTINUE 
-  -  110  CONTINUE 

NAD0«0 
.  RETURN 

120  WRITEI6, 1301NN1  ,NN1  ,Nf4MP,NTPMX 

130  FORMAT! IXt87M€RR0R  fN  AdDTCR.  NUMwE*  OF  TRACERS  IN  PACKAGE  »I3» 
i?2h  exceeded  vtpmx.  nmpi,I3.3h>  •»18,9h  ntpmx  «,.m 

NMP ( NN 1  I «NP 

RETURN 

ENO 

SUBROUTINE  CAROS 

C  •••  READS  INPUT  FROM  CAROS  INTO  BLANK  C OHMONt 

DIMENSION  TaBLEU  >  .CAR0C7I  , LABLE!  11 

.  COMMON  T»3LE 

EQUIVALENCE! Ta9LE( I  I . CABLE C  I  )  > 

INPERRuO 
*R|TE  t  6  >80 1 

tO  RE*0  ! 5  «  90 1  IfNO.LOC.NUMWPC. ICARO! I  I  *  1*1 .NUMWPCJ 

Aft  t  TE  ( 6  > 1 00 1  1END.L0C.NUMWPC. ICAROC II • 1*1 ,NUMWPC> 

IF  INUMwPC.LT. 1 1  GO  TO  50 
IF  1L0C.LT.  II  50  10  70. 

DO  30  j  *  1  ,  N U M  V P C 
J»LOC*l-l 

IF  «  1EMD.NE.2)  GO  TO  ZO 
LABLE! J)»!FIX(CAR0( m 
GO  TO  30 

2g  TABLE! JI-CARD! 1 ) 

3b  CONTINUE 

80  IF  (  1  END . NE . 1 }  GO  TO  10 

IF  (  1NPF.RR«EQ.0I  RETURN 
STOP 

So  IF  1L0C.NE.01  GO  TO  70 

DO  60  J  »  1  > 7 

IF  (CARD! 1  I . Nf • 0  .  I  GO  To  73 
6o  CONTINUE 

WRITE  ! 6 • 1201 
GO  TO  80 

7o  WRITE  (6.1101 

1 NP£RRa  1 
GO  TO  80 

C  FORMATS 

C 

8(J  FORMAT  <  / 1  8h  INPUT  CARDS///! 

90  FORMAT  !  II  > l 5 , I  I > 0P7E9 . 8 » 

1  'JO  FORMAT  (IM  18  ,  17  >  13, 1P7E  18.6) 

I | o  FORMAT  (//82H  *t**  ERROR  ON  'PRECEDING  DATA  CARO  ••*•••*/) 

l 2 0  FORMAT  1 // 1 8H  BLANK  CA*D  **••••/> 

END 

subroutinf.  cot 
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378 

•— 

INCLUDE  COHqIN  - 

379 

C 

380 

c 

381 

c 

•••CHECK  COURANT  CONOfTION  AND  PARTICLE  VELOCITY. 

382 

c 

•••RECORD  l  AND  J  OF  ZONE  WHERE  OT  IS  CONTROLLED, 

383 

c 

•••first  calculate  pressures  from  eq.  of  st. 

389 

c 

”  •  . . '  -  -  -  •  ■  •  •  ■  • 

385 

00  5  K *  1 .KHaX 

386 

PIK)  ■  0.  ' 

387 

5 

CONTINUE 

38  8 

c 

:  - 

389 

6 

TRIAL-0.  r-  . 

390 

SR  A  T  1 0«  1  .  E  ♦  38  .  ■  j  . 

391 

c 

•••SC  WILL  Be  HAXJHUH  U  OR  V 

392 

•SC-0. 

393 

00  60  !•!  ,  1  1 

39  9 

K-l  +  t 

395 

DO  60  J-I.I2 

3  96 

VCELL  ■  TaU(  l  J«rivl J1 

397 

RHOW  =  AHX  (  K  |  /VCELL 

398 

IFIRHOW.LE.O.  1  60  TO  60  -  i -  - -  - . . 

399 

HFK-MFLAGtK) 

900 

JFIHFK.GT. tool  60  To  7 

901 

N-MATlMFM 

902 

9 

ENERGY  m  A  1 X («  ) 

903 

IFIN.Eq.2al  CNERgY-AMAX] (EH1N,A[X(<) 1 

909 

MS«|  .u  . .  •  ■  . 

905 

CAUL  EQST  j 

906 

. . . 

. 

P  1  K  1  «PRFSUR .  -  . . f. 

907 

• 

IF1HEK.LT • 1001  GO  To  30 

908 

—  . .... . 

3 

IF1NhOW.GT.RHO<LSAVe,M» 1  RHOILSAVE.M>«  RHOW 

909 

IF ( PIK1 .LT.O. 1  P1K1-0. 

9  10 

GO  TO  30 

9  1  1 

c 

*••  MIXED  CELL.  ITERATE  TO  FIND  CELL  PRESSURE. 

912 

-  7 

M-MFK-lllO 

913 

DO  10  L-l iNmAT 

V  1  9 

DO  6  E‘-l  ,3  . . .  . -  .. 

915 

D N S ( N , L 1  o  0. 

9  1  6 

PRS(N.l)  «  0. 

917 

8 

CONTINUE 

9  1  8 

-  •  - 

CSWR 1 L ) a0 • 

9  1  9 

WSCRILI-O. 

920 

10 

CONTINUE  1  . 

921 

c 

•••  TO  BEGIN  INTeRATION  COMPUTE  TWO  pressures  for  each 

922 

c 

material  in  the  cell  using  m  densities  calculated 

923 

c 

LAST  CTCLE  ANO  121  THOSE  DENSITIES  INCREASED  BY  0N£ 

929 

c 

PERCENT  » 

925 

1TC-0 

926 

NH«0 

927 

DO  II  L«  I  illHl  T 

928 

IF(  XM.aSSIL  ,NI  .LF.O.  ,CH.  RhD  1  L  ,  H  1  .  L  E  •  0 , 1  GO  TO  11 

929 

CNS12.L)  *  PH0IL.M1 

930 

lsave-l 

931 

IbHATILI 

10 


4(32  NM-NM*  | 

<433  1  1  CONTINUE 

939  -  C  IF  MIXED  CELL  HAS  ONLY  ONE  MATERIAL  (Nm»i), 

935  C  COMPUTE  PRESSURE  AS  IF  CELL  WERE  PURE  AND 

436  c  adjust  material  density  according  to  sign  of  pressure 

R37  IFINK-ll  60,115,12 

hi e  lit  continue 

<09  GOTO  9 

HHO  C 

H «t  I  12  po  13  L«1  ,NMAT 

HH2  IF (XMaSSIL.M) . LE *0 •  I  GO  TO  13 

993  RH0W-DNS(2|L  1 

999  N»MAT ( L  1 

995  WS« 1 «  0 

996  IF < RMOW/PhOZ ( N 1 ,LT • 1 .0 )  *S»-l«0  . 

9  9  7  £NERGY<iSIE«L.M> 

998  IFIN.E0.201  f MERGY-AHAXi (EHIN.SlEtl  »H>  1 

999  CALL  EQST 

950  PRS ( 2 . L 1  ■  PRESUR 

951  C  ALTER  CURRENT  DENSITY  BY  l  PERCENT,  COMPUTE  ANOTHER 

952  C  PRESSURE  POINT 

953  DNS ( 3  ,  L  I  ■  RH0(L,M»*|.0I 

959  RHO*«DNS ( 3  ,L  1 

955  6S«  I  .0 

956  IFCRHOR/RHOZl.Nl  .LT.l  .0)  *S»-I  .0 

957  CALL  COST 

958  PRSI3.L1  •  PRFSUR 

969  |3  CONTINUE  , 

960  C  •••  OETERMlNf  CSQR  CORRESPONDING  TO  TWO  pTS  JUST  DETERMINED 

961  V  5  U  M  *  C • 

962  NFLAG-0 

963  133  IA  SUM*  0  • 

969  DO  19  L«1  .NMAT 

965  IF  (  XMaSSU  .Ml  .LE  .0. 1  GO  TO  19 

966  IF(NFLAG.GT.O)  GO  To  135 

967  CSQRIL)  *‘<PRS(2,L1-FRS(3,L>  1  /  (  DNS  (  2  ,  L  1 -D  NS  (  3  .  L  >  1 

968  VOL(Ll  *  XMASSIL.MI/RHOIL.N) 

969  VSUM«VSUM*VOL(L) 

970  135  CONTINUE 

971  YSQRIL1  «1 .0/»RH0(L,M!*«2  •  CSQR(L)) 

972  .  6  SUM  ■  wSUM*XmASS<L, MI<WS<SR<LI  ■  •  ■ 

973  19  CONTINUE 

979  C 

975  DP=  <  VSUM-VCELL  ) /'ASUM 

976  c  <•<  normalise  densities,  compute  third  pressure  point. 

977  DO  19  5  L“ 1  iNMaT 

978  IF ( XMASS  <  L • M 1 . LE .0.)  GO  TO  195 

979  DV  ■  -DP»V.SOR  ID 

980  VL<L>»1.0/RhO(L.M>*DV 

981  IFIvLlLl-GT.C.)  G°  TO  195 

982  CSOHIL laCSQRIL  1*2. 

983  NFLAG-NFLAG* 1 

989  IF (NFLAG.LE.1PR1  GO  TO  133 

9@S  i-.R  I  TE  I  6 ,3001  T  ,J.ITC.PAV,<XMASS(N,..1  ,0NS<2,NI  ,Slt(N  ,M  1  ,PRS  <2  ,N  1  , 
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CSQRlNI .Nat ,NNaT> 


M8A  .  | 

*«87  ftR I T  E 1 6 . 295 ) 

988  NK»19S 

989  60  TO  ISO 

990  C 

H  V  t  IMS  CONTINUE 

M92  C 

M  9  3  DO  15  1.1 ,NhAT 

999  !FCKM*sS«LiMl.Lf  .0.)  GO  TO  15 

995  DNS  1  1  ,L)"I  •O/VIID 

996  RHOft  a  0NS1 I , L ) 

M  9  7  N»MAT(U) 

M98  W  S ■ 1 iO 

999  If  1  RHOA/RHOZ  IN  )  ,i_T,  l  ,0  1  ftSa-1.0 

500  ENERGY  »  SlE<ti«> 

501  1F(N«EQ'2C)  fKERGY-AMAM ( E^IN ,S 1 E I i ,H M 

502  CALL  E<JST 

503  PRSI 1 ,L)  «  PRESUR 

SOM  j5  CONTINUE 

5C5  IEI INTER.EO.Ol  GO  TO  16 

50*  *RI TE I  6,301 )  ( <LL iDNSILLiU  »PRSILL,L> ,LL“1 ,3) ,L»l  ,NmAT) 

507  C  BEGIN  ITERATION  -  COMPUTE  CSQR  USING  LAST  POINT  ANo 

509  C  CLOSEST  OF  OTHER  T**0. 

509  16  1  T  c« I TC* 1 

510  NFL  A  G"0 

511  C  if  P  OF  ALL  MATERIAL  *LT ♦  PM1N ,  SKIP  OUT  AND 

512  C  ADJUST  DENSITIES  BT  a  CONSTANT  FACTOR  TO  EXACTLY  FILL 

513  C  THE  CELL. 

519  DO  I6S  L“ 1 iNHaT 

515  IFIPRSIJ.Ll.GT.PMIN  .AND.  XMASs (LiHl «GT .0.  )  GO  TO  166 

51*  •  165  CONTINUE  -  . 

517  GO  TO  28 

518  C  .... 

S  1  9  168  CONTINUE 

520  *SUM«o, 

521  P5UM«o. 

522  DO  18  L” 1 i Nm  A  T 

523  IFtAMASSlL.Hl.LEtO. I  GO  TO  J8 

529  IFINFlAG.GT.01  GO  TP  1 75 

525  *SA»ApS<PKS( 1 .L1-PRSI3.L1 > 

52*  IASn«ABSI  PRS(  I  .L1-PRS12.LH  •■■■  - 

527  lFlftSB.LT.RSAI  GO  To  17 

528  DNS  <  2 , L 1  *  DNS ( 3 . L 1 

529  PRS12.Lt  «  PRS13.LI 

530  |  7  ftSX«PRS(2,L  J-PHSI  1  ,L>  -  . . 

53  1  »SY»DNS{2 ,L)«ONSt 1 iL> 

532  |FtABSIftSAl.LF.|.ce-05*ABS(PRS(2tL)|  .OP.  i 

533  I  ABSlftSY I .LE. 1 .0E-05»ABS (DNS t 2 ,L> I  1  GO  TO  175 

539  CSQR<L)-*SX/t:>;Y 

S  35  l 7S  CONTINUE 

53*  *SOK  (  L  I  «  l  .0/ <  nNS  l  t  ,L  1  *»2  •  CS3MLI) 

537  A' S  U  M  a  i ,  S  U  M  ♦  X  n  A  S  S  (  L  .  M  )  •  !'J  S  y  K  1  L  1 

538  PS'JM«PSUH-»PR5<  1  .L>  •XMASS1L.H>»WS0R1L) 

539  18  CONTINUE 
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SRO  C  «•*  COMPUTE  WEIGHTED  AVERAGE  PRESSURE,  NE#  DrNS I  TIES  FOR 

SR  I  c  next  pressure  point 

SR2  PAV-PSUM/MSUM 

5R3  DO  19  L-l.NMAT 

SRR  IFI XMaSS IL .MI .LE.O. T  GO  TO  19 

5RS  OV«'VSQR(L)*<PRS<  I  »L)-PAV> 

SR6  -  VL I L) » I  . O/DNS  (  I  .L » *DV  -  -  . — .  - 

SR7  |F<  VLTU  *GT.O.  I  GO  TO  19 

SR  9  CSQRlL l«CSGR(L»*2« 

SR  9  NFLAG-NFLAG* 1 

550  IFINFLAG.LE.IPiU  GO  TO  1*8 

551  ARITE ( 6,3001  I  , J , I Tc , PA V , ( XM ASS  I N , M I .DNS  I  I  ,NI,SIE(N,M)  .PRSU  iNl  t 

552  -  1  CSORINI ,N«1 .NMATI 

553  *RITEtA,29Sl 

SSR  NK •  1 9 

SSS  GO  TO  1 80 

554  C 

55 2  19  CONTINUE 

558  C 

559  00  20  L* I  iNMAT 

560  IFIXMASSlL.MI  .LC.O.J  GO  TO  20 

561  DNSI3.L)  »  0  N  S  C  2  »  L I 

562  0  N  S  t  2  ,  L  I  •  ONSI  1,1.1 

563  PRS ( 3  ,  L I  «  PR5 ( 2  *  1 1 

5  6  R  PRS(2,U  -  PRS  (  1  .  L  I 

565  C 

564  ONSI 1 ,L)»l •0/VLIL> 

562  RHOA  .  ONSI  I  .1 > 

568  N-MATIL) 

569  *5-1.0 

520  IF  I  RH06/RHO2  (Nl  .LT.  t  .0)  AS  — 1.0 

521  ENEHGT-SIElL.Ml 

522  1FIN.EIJ.20)  ENERGT-AMAXI  IEMINiSiEIi  ,M)  » 

523  CALL  EQST 

5 2 R  PRS ( 1  ,LI  ■  PRESUR 

525  20  CONTINUE 

526  IF<  INTER.  EQ.O)  SO  TO  II 

522  Afil T£ (6 ,300)  I.J.lTC.PAV.IXMASSlL.M) *ONSI 1  >  L  )  .  S  ]  E  I  l  .  M  >  *  PR  S  U  »  L  >  i 

528  1  CSGR(L) ,L»1  ,NMAT) 

s 7 9  c  test  if  iteration  complete 

580  21  PSUM-O. 

581  0 0  2 2  L » l  i  N M A T 

582  IF(XMaSSILiM)  .LE.O.  1  GO  TO. 22 

583  IFIABSI  (PAV-PRSI  1  ,L1  l/PAVI  .GT.PRCNT)  GO  TO  ?R 

56R  IF ( PRS I  1  ,L > «GT  .PM  I  N 1  PSUM-1. 

585  22  CONTINUE 

586  P I K I -0 • 

587  lFCPSuM.GT.O.  I  P(K)*PAV 

588  GO  TO  28 

589  C 

5«0  2 R  IF ( I  Tc.LT.  IPR >  GO  TO  14 

591  AR1TE(6,29S1 

592  *RITEI6,3'J0>  !  •  J*  iTc  ,PAV  .  C  XMASSIL  .Ml  .ONSI  l  ,L>  ,Sl£«L  ,Ml  .PRSU  »L  >  • 

593  1  rSQR ( L ) , L* 1 . N  M  A  T I 
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59** 

NK  *2  0 

595 

GO  TO  180 

59  6 

c 

‘ 

597 

28 

CONTINUE 

598 

c 

STORE  NEW  OEMS  I  TIES. 

599 

00  29  L*I.NMAT 

600 

IFIXHASSa.Nl.CE, 0.1  SO  TO  29  ! - 

60  l 

RHOlL.M)  a  ONS  t  1  ,L1 

602 

29 

C0N1INUE  j 

603 

GO  TO  30 

609 

c 

) . 

60S 

c 

606 

30 

CONTINUE  . -  - i . . 

607 

IF  (ABSlPUn  .LT.PNIM  p  IK  1*0. 

608 

c 

609 

c 

CHECK  FOR  NEGATIVE  PRESSURE . 

6  10 

IFIP(K) .LT.O.  .AND.  (l.EQ.IMAX  .OR.  J.EO.JMAX 

6  1  1 

•  .OR.  1CVJS.LT.0..AN0.J.E0.I ) | 1  PIKl-D. 

612 

65*0  , 

6  1  3 

asa*o • 

619 

c 

CHECK  if  cell  is  mixed. 

615 

IF (NfK.GT.100)  go  TO  33 

616 

c 

617 

c 

618 

c 

6  1  9 

c 

, 

DETERMINE  IF  MATERIAL  IS  POlyTROPIC  gas. 

620 

IFtN-201  32,31,32 

621 

31 

»SA*  SORT (GAHMA«AUS(P(KI 1/RM0*1 

622 

GO  TO  38 

623 

32 

AS*  OiAUT(N)  1 

629 

GO  TO  37 

625 

c 

1 

626 

c 

627 

c 

628 

33 

M*MFK- 1 00 

629 

XM*0. 

630 

CN«C. 

631 

* 

DO  35  N. 1 ,NMAT 

632 

XMS*  XMASSIN.Ml 

633 

IF ( XMS.LE.O. )  GO  TO  35 

639 

MN=MAT 1 N 1  • 

635 

1F1MN.NE.70I  SO  TO  39 

636 

c 

•••  polytropic  Gas 

637 

c 

••...NOTE--  HERE  WE  ASSUME  THERp  IS  ONLY  ONE 

638 

c 

'  IN  THE  ENTIRE  GRID. 

639 

ASa*  SG'Rt  IGAHMa»AiJS(P(KI  l/RHOIN.MI  ) 

690 

GO  TO  35 

69  l 

c 

•»*  NON-POLYTROPJC  material. 

692 

39 

XMaXM.XMS 

693 

CN=CN  ♦  CNAUT ( MN 1 *XMS 

699 

35 

CONTINUE 

695 

IF ( XM.LE.O. |  GO  TO  3? 

696 

A  5  *  C  NV  X  M 

697 

37 

I  F  I  P  (  K  >  .  fc  r  .  0 . 1  '  5  *  S  ♦  R BAR* SORT  (  P  (  x  1  1 

14 


69  8 

38 

flSm  AHAXl  <#S,#SA) 

689 

C 

•••  *S  IS  SOUND  SPEED  OF  CELL  K. 

650 

c 

♦♦♦  *s«  is  h*x)mum  of  radial  and  axial  velocity  of  cell  k. 

651 

c 

ASC  STORES  MAXIMUM  velocity  of  cells  used  to  determine 

652 

c 

ot,  printed  as  NaXUV. 

653 

*•0 

W5b*AMAX1  1  A  8  S ( U ( K )  )  lASSiylK)  )  1 

659 

WSC»AMAXl  USC.KSB) 

655 

*S«AS-.*SB 

656 

c 

«•♦  TRIAL  STfiRES  SUM  OF  VELOCITY  AND  SOUND  SPEED  USED 

657 

c 

TO  determine  ot.  printed  as  maxcuv. 

65S 

IF  (WS.LE.TR1 ALI  go  to  SO 

659 

trial»«s 

660 

So 

IF  (WS.LE.O, I  SO  TO  *0 

66) 

D X Y M 1 N ■ A M I N 1 <DX<  l I  tOY ( J)  I 

662 

RAT  IO«DXYM  In/'»S 

663 

IF  (RATIO. GT.SRATIO)  gO  TO  60 

669 

c 

•*•  1  AND  J  of  CELL  CONTROLLING  OT  STORED  IN  N l 0  AND  Nil 

665 

c 

FOR  PRINTOUT. 

666 

N  1  0»  1 

667 

N1  1  «J 

668 

c 

•••  SHATIO  Is  SMALLEST  VALUE  CALCULATED  FOR  RATIO. 

669 

SRATIO.RATIo 

670 

c 

671 

c 

••♦END  OF  It  J  LOOP 

672 

6n 

K-K.IMAX 

673 

UVMAX.WSC 

679 

c 

♦«♦  SET  FREE  SURFACE  NEG.  PRESSURES  TO  ZERO . 

675 

OC  69  K«2,KmAX 

676 

MFK«MflAG(K| 

677 

(FIMFK.lT.  103)  GO  To  *9 

*78 

h*mfk-ioo 

679 

|F(RH0(nV0I0.m) .Lt*0. )  «0  TO  69 

680 

IF(PU)  .LT.O.  )  P(K)»0, 

68  1 

*9 

CONTINUE 

682 

c 

•  •«  if  TRIAL. LE»0.  THERE  IS  pROBABLY  AN  ERROR  IN  THE  INPUT 

*83 

c 

689 

c 

PARAMETERS  FOR  THE  INITIAL  VELOCITY,  ENERGY  OR  DENSITY 

685 

c 

of  the  Packages,  or  in  the  x,y,dx,dy  arrays. 

*86 

65 

IK  (TRIAL. LE. a.)  GO  TO  170 

*87 

c 

•••  IF  FI V6L. £0*0. USE  STAB  FOR  VALUE  OF  STABILITY  FRACTION 

*88 

c 

IF  FINAL. GT.O. USE  A  GEOMETRIC  PROGRESSION  WITH  STAB 

689 

c 

as  the  initial  value  and  final  as  the  mnal  value. 

690 

IF  (FINAL. EQ.O. I  GO  TO  70 

691 

STAa«2.«STA0 

*92 

ST AB»AH|Nl (STaB iF INAL » 

693 

70 

0T«STA8»SRATIO 

*99 

1  F ( OT • LE • 0 • )  GO  TO  150 

695 

IF  (STAH*LT. FINAL*  go  to  80 

*9* 

c 

•  ••  AFTER  ST4B.GE. FINAL  C  H  E 1 K  ON  SIZE  OF  OT ,  dTMIN  IS  AN 

*97 

c 

INPUT  PARAMETER  AND  CAN  BE  SET  TO  D. 

*90 

7s 

IF  (DT.LE.OTMIN)  GO  TO  150 

*99 

Ho 

CONTINUE 

700 

c 

701 

c 

•••  |S  control-cell  isolated 
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702  K« ( Nl  1  - J  ) • ltfAX*N 1 0* 1 

703  *S»0» 

70*  1  F  (NIO.GT.I)  WS.AMXIK-i} 

705  If  IN10.LT. IMaXJ  WS»AMX(K*l  )  ♦  W  S 

706  If  (NlI.GT.tl  WS>4MX(K-!HAX)*«S 

70  7  If  (Ntl.LT.jHAX)  IVSaAflX  <  K*  I  MAX  )  *WS 

708  .  IF  (Ws.gT.O.)  GO  TO  90  -  .  .  . 

709  c  •••  ISOLATED.  SO  OESTROY  tT. 

710  tt?S=t A t x (X >*IH(K ) «#2  +  V (K ) «*2>*.5) »AmX > 

711  EVAPM»EVAPM*AMX IK  I 

712  EVAPENsEVAPEN+WS 

713  ETh«ETH-*S 

71* -  E  VAPMUsfVAPmU  AMX  I  K  )  »U(  K  1  . •  •  ■  L— -- - - - : .  ■■ 

715  £  V APMV>E V APMVA AHX < K ) • V ( K 1 

716  WRITE  (6,2901  N 1 0 . N 1 1 , T , OT , TR I AL • *SC . UM I N , PM  I N —  :  - 

717  A  M  X  I K 1 • 0 . 

7  18  A  I  X  <  K  )  a  0  •  -  1  . - . 

719  P  (  K 1*0. 

770  U<K 1=0. 

721  V ( K I »0 . 

722  ME  K.Mf  L  AG  <  K  I  . — ■  -  ■  ■' . . — . . 

723  IF< MFK.LT. 100)  GO  To  6 

72*  ■  MbMFK-100  . .  - . . 

725  00  82  N>l  ,NMAT  * 

726  XMASS(N.M)  >0, 

727  SIE(N.M)  .0. 

728  82  COMT  INUE 

729  C  •••  RECALCULATE  OT. 

7  30  GO  TO  6  . -  ;  . -  - . . 

731  C  INCREMENT  TIME  AND  CYCLr. 

732  -  90  T»T.DTNA  .  1 . 

733  9s  IF  1 T , LT • C . 1  GO  TO  1 60  ! 

73*  N  C  *  N  C  ♦  1 

735  CTCLE.NC 

736  ■ 

737  C  RfSET  NPP 1  NT «  »PR1NT»1  ON  PRINT  CYCLES. 

738  NPR 1NT-0 

739  C  •••  DEFINE  VELOCITY  AND  ENERGY  CUTOFFS  USED  rN  MAP  AND  PH? , 

7*0  UMIN»TRIAL*ROFPS 

7*1  S1EM1N*UM1N»*7 

7*2  DO  1*0  L”!  » NM A  T 

7*3  N  =  MA  T ( L I 

7**  IFtN.EQ.20)  GO  TO  1*0 

7*5  AS  »  RHO*  1  N)  »CNAl)T  IN)  •UM1N 

7*6  PMIN  .  a*IN| (PMIN.6S) 

7*7  | M  0  CONTINUE 

7*8  V,R  I  TE  (  6 ,280  )  nC 

7*9  WRITE  16.2901  N 1 0 , N 1  |  , T , 0 T , T R I  A L » *>S C . UM ! N , PM  I N 

750  OTNA=OT 

751  GO  TO  190 

752  C  j 

753  C  .*•  I)T  TOO  SMALL 

75*  ISO  NK » 7 5 

755  GO  TO  IflU 


I 

I 
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•M  T  IS  NEGATIVE 


7  56  C 

757  1 60  NK-95 

758  GO  TO  160 

769  C  •••  OT  MLL  8E  NEGATIVE  OR  7ER0. 

760  170  NIC-65 

761  60  TO  ISO 

762  IPO  NR»3 

763  CALL  ERROR 

761  C 

765  |90  RETURN 

766  C 

767  78 0  FORMAT! IX, SHCYCLE, 15) 

768  290  FORMAT  (  /9rt  Cf>T  ,  I  3  ,  I  *1 ,  9h  T* » I  PE  I  3 . 7 , Sh  t)T«  ,  1  Pe  1  3 . 7  . ’H  MAXCUV-,1 

769  t  PE l  3 • 7 • 8H  MAXUV-, IPE13.7.7H  UM I N« , 1  PE  1 3 . 7 « 7h  Pm ! N» , 1  PE  1 3 ♦ 7 ) 

770  ?95  FORMAT ( /33H  TROUBLE  WITH  PRESSURE  ITERATION  ) 

771  300  FORMAT 1SH  I  *  13,  9H  J  »  13*  6h  I T  C  ■  13,  6H  PAV  ■  1PE20.8/ 

772  210X,  IOH  MASS  ,10X,  10H  OtNSlTY  .10X.I0H  SIE  ,IQX, 

773  3  10M  PRESSURE  •  I □ X  IOH  C5QR  /(1P5C20.8)) 

7  7  9  301  FORMAT! 16, IP2E20.8) 

775  END 

776  SUBROUTINE  COmPRS(L) 

777  c«***  ***•*••  *•••*•>*•****•**•******• 

778  C  SUBROUTINE  COmPRS  TAKES  TWO  CELLS  L  AND  M,  COMBINES  THEM 

779  C  INTO  ONE  CELL  K  AMO  ZEROS  OUT  THE  Ot.0  CELLS* 

780  C 
78  1 

782 

783 
709 

785  • 

786 

787 

788  C 

769  C  8  0  Th  CELLS  APE  EMPTY  OF  MASS. 

790  C«  . 

7  V  1  IF  !  M  F  M  <  E  Q  .  0  )  GO  TO  60 


ERROR  found  IF  CELL  M  IS  NOT  MIXED  OR  VOID. 


IFCMFM.LT.  10060  TO  RO 
IFIMFL.EQ.0lGO  To  Sc 


ERROR  FOUND  if  CELL  L  IS  NOT  M | XEO  OR  VOID. 

799  c  •  •••««•»•*••*•**••*•**  .  ***«•»••«* 

800  IFIMFL.lT . ICOIGO  TO  RQ 

801  IF ! MFL . GT . MfM ) GO  TO  1 0 

802  . . * . . . *  *  *  * 

803  C  hOTM  CELLS  MIXED.  7FR0  OUT  ONE  AFTF'T  TRANSFERING  DENSITIES  To  OTHER. 

809  C. *•••••*••**»••*••••  .  ..«*• 

805  MM-MFL-100 

806  nNbMFu-ICO 

807  MFLAGIK  l=MFL 

808  GO  TO  20 

809  ] O'  mM=MFm- 1 00 


792  C 

793  C 

759  C 

795 

796 

797  C 

798  C 


INCLUCE  C  0  M  c  1  m 
MFU«MfLAG<L) 

MFM=MfLAG(M) 

MFLA6(M)=0 
MFLAG(L)”0 
WSA« AMX ( L ) +AMA ( M  > 

IF ( ABS I W5A ) ,GT .0. ) GO  TO  100 
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I 


5  I  0 
61 1 
812 
8  I  3 

e  i  *♦ 

615 

6  1  6 
8  1  7 
8  1  8 

819 

820 
82  1 
822 
823 
8  2  9 
825 
8  2  4 
e27 
828 

829 

830 

831 

832 

833 
83  9 

835 

836 

837 

838 

839 
890 
89  1 

892 

893 
899 
8  9  5 
8  96 
8  9  7 

898 

899 
850 

85  I 

852 

853 
659 

855 

856 

857 

858 
8  5  9 
860 

86  1 
P62 
64  3 


nn-mFl- I  00 

MF  LAG ( K  )  «MFm 

7  0  IM  RHOU  ,NN)  .  r-T.O.  »RHO«  1  ,HM>«RhO<  1  ,  NH> 

RHO 1  I  , NN ( 1 • 

c.«.  ««**»•*. 

c  error  found  if  mixed  cell  not  free  surface. 

C.. 

IF  I ABS (RH0(NV010,NN»-| .  )  .6T.0. »60  To  80 

RH0tMV01D>NN)=C. 

DO  25  II* I »HM*T 

1F1RH01  1  l  .NM.GT.C.  )  RHO  (  I  I  ,HMI»RHO(  I  I  ,NN) 

IF  t 1 1 . NE • 1  )»hd < I  |  ,NN ) .0, 

75  S I F (  1  I  ,MM)«c* 

. . . 

C  ERROR  FOUND  If  MIXED  CELL  NOT  FREE  SURFACE. 

. . . 

30  IF ( APS ( RHO ( NVO 1 0 . NM I - l .  ( .GT . 0. ) go  To  80 
80  ANX(K)aO. 

A  1 X (K )«0« 

U  <  K  >  *  0  • 

V  IK  )  »fl. 

STHSRR (K I .0. 

STRSR2(k)»0. 

STRSZZ1k1*0. 

GO  TO  120 

c  .  »  •  * . . . 

C  CELL  L  IS  VOID  AND  CELL  N  IS  MIXED. 

c«  ............  ........... 

50  RFLa6(K)=MFm 
MNsMFU- | 00 
GO  TO  30 

C..  .......  •  ••••••••*.•*•• 

C  CCl.L  M  IS  VOID. 

. . . . 

1 F I  NFL, ME .0 ) GO  TO  7n 

C  *  •  »  »  *  * . . 

C  BOTH  CELLS  A  R  F  VOID. 

c.  .......  ...... 

MFL AG ( K ) «0 
6  0  T  0  9  0 

C*.  ...........  ........... 

C  ERROR  FOUND  IF  CELL  L  IS  NOT  VOID  OR  MIXED. 


70  IFINFL.LT.ICjCIGO  TO  80 

C«  ..A*. 

C  CELL  M  I  5  VOID  a  NO  CELL  L  IS  MIXED. 

c.».  ..............  . . 

MI  LAG  (  k  »  =MF|. 

H  M  a  M  F  L  -  |  0  0  i 

GO  TO  30 

. . . . .  . . 

C  ERROR  EXIT.  A  CELL  V.  A  S  FOUND  WHICH  HAS  ZERO  MASS  A,D  WHICH  **5  NOT 

C  veto  OH  FREE  SURFACE.  OR,  0  OTH  CFLl  S  PURf.  ftUT  OF  OlFFERtNT  MaTER|AL. 


•vZ 


K 
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84** 

665 
644 
667 

666 
869 

670 

671 

672 
873 
879 
e7S 

876 

877 
678 

879 

880 
661 
682 
683 
ee** 
ees 
686 
687 
8  88 
889 
690 

891 

892 

893 
899 

8  9  5 
e96 

89  7 
698 

899 

900 

90  1 
90  2 

90  3 
909 

905 

906 

9  U  7 

908 

909 
9  1  0 

91  1 
912 
9  1  3 
9  1  9 
915 
9  1  A 
91  7 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 


80  PRINT  90»L»MFi .M.MFH.AMXCM) 

90  FORMAT! ix. 20HFRR0R  IN  COMPRS.  L« , I  9 . 3* , 9HMFL- . I  9 , J X . 7H AMX IL) ■ » 
I E 1 5 . 5 .SX • 2HM» , ) 9 ,3X ,9HMFM« ,I8,3X,7hAMX(MJ«,E|S.SI 
CALL  EXIT 

ONE  OR  BOTH  CELLS  CONTAIN  MASS. 


{ HU  JFOiFm.gT. ICO. OR. MFL.flT. 100)60  TO  190 


ERROR  FoL'NO  if  80Tri  CELLS  PURE  BUT  of  DIFFERENT  MaTEPIAL. 
IF1HFM.nE.MFL >G0  TO  80 


BOTH  cells  pure  and  contain  same  material.  COMBINE  the  two  cells  to 
form  A  NEW  PURE  CELL  SO  THAT  MASS,  MOMENTUM  AND  ENERGY  ARC  CONSERVED* 


MFC  A G ( K I “MFL 

OUk«(U(L>*AMX<L) ♦U(M).AMXIM) l/WSA 

V  Vic*  (  v  <1. »  »AMX  (L  I  *V  (M  I  •  AM*  <  I /WSA 

T.  S  =  UUK»*2  +  VVK**2 

no  WSB>*AHX!L)»(U(Ll»«Z  +  V(Ll»»2>  +  AMX(M)»(U(MI**2  +  V!M)**2l 
U  <  K ) =UUK 

V  (  K  1  •  V  V  K 

A1X(K)=AIX(L1*AMX(U|+AIXIM)*AMX(M> 

STRSRR  1  Kl  •■!  AMx  !  LI  •STRSRRll  I  tAMxlM  l  *STRSRR  !M»  )  /  WSA 

STRSRZ  (K  )■!  AMX  1L)  •STRSRKLI  ♦AMX(N|  «STRSRZ!M)  I/WSA 

STRS2/IK>««AMX!LI*STRSZ2(L>*AMX!MJ«STRSZZ(M)  >/*SA 

AMX  (  K  )  *V.SA 

E-A I  X ( K I ♦ .S»AS8 

A1X(K)»E/AMX  (<)-.S»'AS 


ZERO  OUT  THE  ORIGINAL  TiaO  CELLS. 


120  IE! M.EG.K )G0  TO  130 
A  I  X (M ) =0* 

AMX(M)«C* 

U  !  H  >  •  0  . 

V  <  M  I  «  0  . 

STRSRR(m1=0. 

S  T  RSR  Z <  Ml =0. 

STRSZZ ( M  »  »0. 

130  ific.eq.kiReturn 

A  I  X ( L  >  *0* 

AMX(L»=0. 

U  .1  L  >  *  0  , 

V II 1=0, 

STRSRR ( u 1 “0, 
STRSRZIL  >"0. 
STRSZZ(L»"0. 

RETURN 


ONE  OR  P.OTH  Op  THE  T  VO  CELLS  ARE  M|xEO*  SET  UP  T»0 

temporary  mixed  cells  and  zero  out  existing  mixed  cflls. 
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918  MO  00  160  11-1,2 

919  00  150  JJ-l.NMAT 

920  XMAS! I l.Jjl-O. 

921  SSIEI II  ,JJI-0. 

922  150  XRh(  t  t  ,  JJMO. 

923  RVM*0. 

928  HVL«0, 

925  IFMFH.lT.  100150  TO  160 

926  €••  .  . 

927  c  cell  n  is  hixeo,  transfer  properties  to  temporary  mixed  cell 

928  (•«••••••  .  •«•«•»••• 

929  N=MFM.loO 

930  RVM»RhO(NVOID,M|' 

931  JJM  ! 

932  GO  TO  170 

933  160  J  J=  2 

938  C  •••«••••**•** 

935  C  CELL  L  IS  MJXCD.  TRANSFER  PROPERTIES  Tg  TEMPORARY  MIXED  CELL. 

936  c.« 

937  N-MFL-100 

939  RVl»RH0(NV01D,N| 

939  I  7 U  DO  180  Jt-I.HMIkT 

980  XMASl  JJt  m-XMASS(  1  1  ,N» 

981  SSIEI  JJ,  I!)-STF.m  ,N) 

982  XRH ( JJ, 1 1  | -RHO<  I  1  ,N) 

983  XMASSt  I  I  .N)«0. 

988  SIE(II,Nl “0. 

985  180  RHOdl.NlaO, 

986  RHO I  I  ■ 

987  RH0(MV0(D*N)-O. 

988  IFI JJ#EU»2)G0  TO  190  . 

989  1F1HFL.GT.  iOOlfiO  TO  160 

950  MO  1  F  I  MFM.  GT  .  1  00  )  GO  TO  200 

951  I F ( MFM . £0 . 0 ) GO  TO  210 

952  C  •  . . '  .  •••«••••  »  6  *  .  *  •  • 

953  c  CELL  M  IS  PURE.  TRANSFER  PROPERTIES  TO  TEMPORARY  MIxEO  CELL. 

958  C  *  »  .  ....................... 

955  XMASl 1 ,MFM!=AMX (M) 

956  SS t E 1 V , MFMI = A | X M I 

957  JJ«(M-2)/1MaX.1  ! 

958  I  I =M- 1  -  1 JJ- 1  )  .  IHAX 

959  XRH  1  1  ,MrM  MAMXM  W  (  T  AU(  1  l  >»DY  1  JJ1  ) 

960  200  IFIMFL.gT. 1 00 > GO  TO  210 

961  IF  I  MFL.EQ.OIGO  TO  2.10 

962  . . . . . 

96  3  C  C  CL  L  L  IS  PURE.  TRANSFER  PROPERTIES  TO  TEMPORARY  MIxEO  CELL. 

968  C  •  •  •  •  «  •  ..................  ......... 

965  .XMAS(2,MFLl-AMX(U 

9  66  SS  1 1  1  2  .MFl,  )  -A  T  X  1  L  > 

967  JJ=1L“2)/1MAX*I 

968  !  I =  t - 1  - ( JJ-1  J.IMAX 

9*9  X  R  H ( ? , MF  L ) =  A  M  X  f  L I / I T  A  HI  1  I  >  *  D  Y 1 j j )  ) 

970  ?10  MFLaG I K ) *N* 1  CP 

971  C.** 
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i  r* 


972 

973 
979 

975 

976 

977 

978 

979 

980 

98  1 

982 

983 
9  8  9 

985 

986 

987 

988 

989 

99  0 

991 

992 

993 
999 

995 

996 

997 

998 

999 
1000 
1001 
1002 
1003 
1009 

1005 

1006 

1007 

1008 

1009 

1010 
1011 
1012 
10  13 
1019 

1015 

1016 
1017 
10  18 

1019 

1020 
1021 
1022 
1023 
1029 
1025 


C  FORM  A  NEW  MIXED  CELL  K  BY  COMBlN|Nr.  THE  TWO  TEMPORARY  MIXED 

C  CELLS  SO  that  HASS.  MOMENTUM  AND  ENERGY  ARE  CONSERVED* 

c.  •♦•*••••••••  •••*•♦••••*••••♦***••*< 

RH0(IIV0ID,N)  =  1  . 

lF(A0S(RVMl.|f.O,.AND,APStRVL>»LE.O.)RHO(NVOIf).Nl»O. 

UUK»  1  u  1  L  >  »AMX  I  L  1  *u  t  K  I  *  AMA  1  Ml) /WSA 
VVRalVIl.  )»AmX(L1*V(mj«AMX(M))/WSA 
«S*UUK ••2*VVK*«2 
00  230  11  =  1  ,  NN  A  T 
WSBaXMAS  <  I  .  m«XMASI  2  ,  111 
IF  I  ABSIV/SB  >  •  L  E  •  0 .  )Go  TO  220 

RHO  C It , N I  =  I  XMAS  «  |  ,  1  I) *ARH» 1  ,  I  I ) +XMAS 1 2  * ! t 1 *XRH  I  2  i  II  I  I /WSB 

»»SC»XHAS< 1 » 1 1 l*(U|M}«*2*V(M)»»2)*XMASf2.II)*(UIL)»»2*V(L)»*2) 

SIE(Jl,N»*SSlE(l.lI)»XM.ASll.IIl*SStE(2,lI>»XMASt2.I!) 

XMASS(H.Ml=*SB 

E*5  1 1  (  II  *  N  >♦.  5»"'SC 

S I E (  I  1 ,Nl*E/WSb-.S»¥S 

GO  TO  230 

220  X  M  A  S  5  < 1 1 . N ) *0  * 

SIEI II  ,N1=0. 

RH0(ll,N»»*5»IXRM(l.n»TXRH<2tirH 
230  CONTINUE 
GO  TO  1 1 0 
ENC 

SUBROUTINE  EDIT 
INCLUDE  COMOIM 
C 

C  SPECIAL  EQUJV.FOR  EOlT 

c 

c  ERoUMPal.  WHEN  ERROR  CAi'lS  EDIT  FOR  A  TAPE  DUMP  ONlY 

IF  IERDUMP.gT.O. 1  GO  TO  150 

c  ENERGY  Sum  (ESL'M)  and  RELATIVE  ERROR  IN  SUM  (RELERR) 

C  COMPUTED.  Ecu  IS  LARGEST  ERROR  COMPUTED  and  On  PRINT 

C  CYCLES  IS  PRIMED  AND  COMPARED  TO  DMIN,  MAXIMUM 

C  ALLOWABLE  ERROR. 

ESUM«0. 

00  10  K«2,KMAX 

If)  ESUh*ESUM*AMX(Kl»(.5»(UIX)»*2+V(K)»»2)+AIX(Kl) 

RELERP-tESUM-ETHI/ETH 

IF  I ABSIRELERR I *LT. ABS1ECK ) »  GO  TO  20 
ECK-RELERR 
necycl*nc 
20  CONTINUE 

c  •••  adptcr  called  when  nado  (Inputi  .gt.o.  nadd  also  tells 

C  NUM8ER  OF  TRACERS  TO  ADD  BETWEEN  ANY  TWO  EXISTING 

C  TRACERS  IN  ThE  SPECIFIED  RE6I0N. 

IF1NADD.GT.01  CALL  AODTCR 

C  •••  NPR1NT  »  I  WHEN  EDIT  IS  CALLED  TO  DO  AN  INTERME01atE 

c  print.  Skip  tests  on  time  to  stop,  print,  rezone. etc. 

C  WHICH  ALREACY  HAVE  BEEN  DONE  FOR  THIS  CYCLE. 

IFINPR1NT.E0.  t  )  GO  TO  1 90 
c  •••  I3«l  SIGNALS  a  short  print 

I  3  ■  l 

c  ...  IF  This  IS  FIRST  CYCLE  OF  RUN,  *FLAGF*1. 
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1026 

1027 

1028 
1029 

c 

1030 

1031 

C 

1 032  - 

1033 

1039 

C 

103S 

c 

1036 

10  3  7 

30 

1038 

1C  3  9 
1090 

109  1 

1092 

1093 

NO 

1099 

1  09S 

c 

1096 

1097 

95 

1098 

C 

1099 

50 

1  cso 
lost 

I  OS  2 

1  CS3 

C 

10S9 

60 

loss 

C 

10  5  6 

c 

1057 

70 

1058 

1059 

c 

1060 

106  1 

c 

1062 

c 

1063 

1069 

1065 

1066 

c 

1067 

c 

1068 

1069 

80 

1070 

1071 

1072 

1073 

c 

1079 

1075 

1076 

c 

1077 

So 

1078 

c 

107? 

1  oc 

IF  <WFLAGF*GT.0.>  GO  TO  I 2G 

IS  THIS  The  tihe  OR  CTCLE  TO  STOP  EXECUTION 
IF  ( ICStOP.LE.NC.*NO.ICSTOP,GT.O»  60  TO  30 
IF  tT» (1 .*KOEPS> .GE.TSTOP. AND . TS TOP . GT ( 0 . )  SO  TO  30 
•  ••  SHOULD  the  GRID  3  E  REZONEO 

IFI  (  (R£Z*N'E,C. .ANO.REZFCT.NE.O. ) .OR.SSS.NE.O. ) .aNO.NUMREZ.GT.O) 
160  TO  190 

GO  TO  90 

SET  »FLAGL-1.  TO  Sat  this  IS  LAST  CTCLE  OF  RUN 

T(FLAGL"!  • 

13-11 
NPRINT-l 
NUMSPT -N0UMP7 
NUHSP-0 
GO  TO  190 

ASSIGN  MO  TO  LOCA 
ASSIGN  1 10  TO  L0C8 

•••  ARE  *E  PRINTING  ON  TIME  OR  CTCLE  INTERVALS 
IF  (PRDELT.NE.O.  1  GO  TO  SO 
IF  I  1 PCYCL . NE . 0  I  GO  TO  100 
60  TO  930 

PRINTING  ON  TIME*  IS  IT  TIME  TO  PRINT 
IF  < T- (  |  . *ROE PS  1 . GE .PRT I  ME  1  GO  TO  70 

HO.  BUT  TILL  NEXT  CTCLE  BTPASS  THE  PRINT  TIME 
IF  ( PRT I  HE .GE . T  +  DT )  GO  TO  60 
DT.PRTIME-T 
0  T  N  a  «  0  T 

GO  TO  LOCA ,  (I  90 , 1 301 

yfs,  >T  is  time  to  print,  nprint-i  flags  this  as  a 

PRINT  CTCLE. 

NPRINT-I 

•••  AVOID  TRUNCATION 
T-PRTIME 

•••  IS  IT  TIME  TO  RESCALE  PRINT  INTERVAL 
IF  IT»( I .+R0EPS1 .LT.PRLIM.OR.NUMScA.LE.O)  GO  TO  80 

CHANGE  PRINT  INTERVAL  ANd  THE  TI*E  FOR  TmE  NEXT 
RESCALING. 

PRDELT-pROELT.PRP  ACT 
PRLIMbPrLIM.pafacT 
NUHSCA -nUhSCA- I 

•••  DEFINE  TIME  FOR  NEXT  PR|NT. 

PRT I ME-T*PRoELT 

1 1  S= IPRT INE  +  .E*PPDELT I /PKDELT 

TS-IT.S 

P  R  T  I N  f  »  S  »  P  R  f  E  L  T 

**•  Fill  T  E  PTPASS  TIME  TO  pRINT 
IF  tPRTJME.GE  .T  +  r.Tl  GC  TC  90 
**•  Y  f  5  .  ADJUST  01 
CT-PR1 IMt-T 
OTha-DT 

GOTO  LOCH.  1110,133) 

PRINTING  ON  CYCLES.  |5  THIS  A  PRINT  CYCLE 
IF  (MCDiNC  ,  IPCYCl  )  .  NE . 0 )  GO  TO  60 
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1080 

C 

YES  «  NPRINT  »  1  FLAGS  THIS  AS  A  PRINT  CYCLE. 

lost 

NPRJNT-1 

1062 

c 

**•  is  this  the  cycle  to  rescale  print  interval 

1  * 

1  063 

IF  (NC.LT.PRLIH.C'R.ML'HSCA.LE.O)  go  to  90 

*•  * 

1088 

c 

1065 

c 

•  ••  YES  •  MULTIPLY  HUMBER  OF  CYCLES  BETWEEN  PRINTS  BY  PRFArT 

1086 

c 

♦  -/ 
y 

1087 

IPCYCL=INTtPFFACT)«irCVCL 

,«C 

1  0P8 

PRL 1M*PRFACT*PRL IN 

1089 

NUMSCA  =  HUf!SCA-l  ■*. 

1090 

GO  TO  LOCO ,  (110,130) 

1091 

c 

...  TEST  FOR  SHORT  OP  LnNG  PRINT 

1092 

c 

MIVSP  COUNTS  NUMBER  of  SHORT  PRINTS  SINCE  LAST  L0N6 

1093 

c 

PRINT.  MOHSPT  COUNTS  NUMBER  OF  CTCLES  SINCE  LAST 

109  9 

c 

TaPF  DUMP, 

1098 

I  1  0 

HUHBP.NUH5P+ 1 

1096 

. 

NUHSPT-MUH5PT* 1 

1097 

IF  INUMSP.NE.NFRFUP)  CO  TO  190 

1098 

NUHSP*0 

1099 

c 

•••  13*11  signals  a  long  PRINT 

1  100 

120 

1  3*  I  1 

1101 

c 

...  pfj inf  OF  FCSJAKl  CYCLE  PILL  BE  SHORT  IF  PKOl.EU*  -2. 

1  102 

IF ( RK ( 3 )  .E  .0 . -2.  .AND.  * F L A  OF • G T  .  0  .  )  13*1 

1  1  03 

GO  JO  190 

1108 

c 

•*•  CHECK  FOR  ENERGY  DISCREPANCY 

1  ICS 

1  30 

IF  Ul’SlECM  .CT.nF'INl  CO  TO  880 

1106 

c 

IF  LAST  CYCLE,  RF«IHD  TAPE 

1107 

1  80 

IF  (WFLAGL.EO.ri.)  GO  TO  870 

1108 

REWIND  kunitu 

1  109 

GO  TO  870 

1110 

iso 

N  U  t :  S  P  T  *  0  ' 

1  1  1  1 

IF  ( NPOUHP.flE.C )  GO  TO  17C 

1112 

BACKSPACE  KUNITW 

1113 

WS=55S . 0 

1118 

WRITE  t  K  UN  ITU)  US,  CYCLE 

1115 

WRITE  (kNNITWI  (2(1),  1*1.150) 

1116 

WRITE  (KUNITK)  < U (  !  >  , V (  1  )  ,  AMX {  ,  s  |X (  1  1  ,  PCI).  MFL A G <  I  )  .  I ■ 1 . K M A  X  1 

1117 

WRITC  (  K  U  i ;  1  T  ii  )  tSTRSZZll),  STRSRR(I),  STRSRZfil,  I-l.KMAX) 

1  1  IP 

WRITE  IKUNITW)  ( X  (  |  1  i  L'X(I),  TAU(I),  I«I,IMAXI 

1119 

WRITE  IKUNITW)  (Y(|),  13  Y  C  11  •  1*1,JMAX) 

1  J20 

WRITE IKUNITW)  ICZERO(M),  STKllMl,  STK21M),  STFZ(M),  RHUtHI, 

1121 

1  AHDH(M),  RhOJN(M),  SSlENCNi.  UUR(M),  VVA(M),  MaTIM),  PLMfH, 

1  122 

2  M* 1  , NH  A  T  > 

1  123 

V.  R  1  TE  (  KUM  I  TW  I  (  NP  A  C  (  I  )  .  HP  AC  K  (  1  >  ,  I  *  1  ,  MB  BB ) 

1  128 

WR  I  TE  (  KUH  i  T  )  (  (  P  A  C  X  (  1  ,L)  ,PaCY(  I  ,LI  ,  1  =  1  » M  B  88  1  .1*1  .HBB  ) 

1  1  25 

WR I TE ( Kl/N I TW )  ( (XHASS(W.L) »  RH0(M,L1 ,  SIE(M.L),  SaMPYIN.L). 

1  l  26 

1  SAHHPlHtL),  H-l.NMATl,  R H 0 ( N V 0  1  0  ,  L  1  .  L»I.NMXCLS) 

1  127 

0  0  J  6  [1  M  *  1  .  N  V  0  I  0 

1128 

NP=NMP ( N ) 

1  1  29 

WR 1 TE (KUNI TW)  NP . 1 TX (N  ,L  >  »TY (N  ,L )  ,L«I  <NP  » 

*  / 

1  130 

1  6U 

C  0 H  T  I  IIUE 

1131 

NP=(  IMAX/2+1  )  •  (  .IMAX/2*  1  ) 

1  132 

WR I TE ( KUNI Tw )  NP , ( XP (L  )  ,  VP(L),L”1,NP> 

1  1  33 

W5  =  666 .0 
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t 


t  1  3H 

wRITE'KUNlTt!)  WS,  WS 

1  1  35 

WRITE  ( 6 i 550 )  NC 

t  136 

I F  t«rUAf*L.EQ.O.  1  GO  TO  17U 

t  1  37 

END  File  KUN1TW 

1  1  39 

1  70 

CO  NT  I I4UE 

1  139 

IF  (EROUMP.GT.O. »  GO  TO  H  7  C 

1  1  HO 

GO  TO  280 

1  1  H  1 

C 

initialize  ph  array,  temporary  storage  for 

energy, mass 

1182 

C 

AMD  MOMENTUM  TOTaLS  PRINTED  OUT,  ; 

1  1  H3 

1  90 

DO  20(1  J=  1  ,8 

i 

1  1  H  H 

00  200  Ma 1  *  NVO I 0 

73- 

1  1  MS 

200 

P  3  1  M  ,  J  1  a  0  • 

1  1H6 

C 

1  1  H7 

0023SK=2.KMaX 

1  1  H  8 

MF=  MftAGIK) 

1  1  H  9 

IFIMF.GE.1001  GO  TO  210 

t  ISO 

M  1  »  ME 

1151 

M2*  ME 

PJ 

65-*  A11X1Y.  ) 

1  153 

tv  S  1  a  A  I  X  (  K  )  *  v  (  S 

1  1  5  H 

60  TO  215 

1155 

C 

1  1  S  6 

210 

MC*  MF-tOO 

1  157 

M  1  a  1 

1  1S8 

M2*  N  H  A  T 

1  159 

215 

DO  2  3a  M-M  1  , M2 

1  1  60 

C 

1161 

IF1ME.LT. 1001  GO  TO  220 

1  162 

AS=  XMASSIM.MCI 

1  163 

71 5  I  ■  SIEIM,MC)*.<5 

1  1  6  H 

220 

P0<  M  ,  1  1=  P<}<  M  ,  1  1  ♦  AS  1 

1  165 

P3lM,2)«  P‘J(M,2>  ♦  ,S«WS*  (U  (  K  I  **2  *  V  (  A  )  *  *2  1 

1  166 

pgiM,<o.  pi]|M,n  .  ws 

1  1  67 

ASA*  'VS  *  V  IK) 

1168 

PQIM.SI*  P'J(M.S)  ♦  MSA 

1  169 

IF  (WSA.6T.0.)  P  0  1  M  ,  6  1  *  P3(M,6>  *  wsA 

1  1  70 

PQ(M,7)a  P  3 ( M , 7 )  ♦  WS«U ( K ) 

1171 

2  30 

CONTINUE 

1172 

235 

CON  T 1 NUE 

1  1  73 

C 

1  1  7H 

00  2  H  0  Ma 1  »  NM  A  f 

1  1  75 

P3('1,3)=  Ml.’/  (Ml 

1  1  76 

2H0 

P  3  t  M  i  3  )  a  P  3  (  M  ,  1  1  *  P  Q  (  tl  ,  2  1 

1177 

c 

TOTALS 

1  173 

00  2  H  S  J* 1  , S 

1  t  79 

S  U  M  »  0  , 

1130 

00  2  M  2  M=1  ,NMaT 

113  1 

2  H  2 

SUM  *  SUM  ♦  P  1J  (  M  ,  J  1 

1  |  32 

2  H  S 

POlNVOIOiJla  SOM 

1133 

IF  (I9AX.GT.ij  go  TO  260 

1  1  93 

c 

1135 

c 

•••  IE  DOING  a  1-0  PROBLEM  ij  1  V  1  L)E  TOTALS  BY  wZ 

where 

'  * 

l  196 

c 

NZaH*. (NUMBER  OF  TIMES  THE  GRID  HAS  hEEN  REZONED.) 

V  * 

1137 

c 
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1188 

PROP 

( 1 )»ETH/NZ 

1199 

PROP 

( 2 ) *ECK /NZ 

1  l  90 

PROP 

1 5 1 “EZPM2/NZ 

1191 

PROP 

(  6  1  =BB0'JN0/  12 

1  (92 

00  250  J-l i29 

1  193 

290  PROP 

(J*6)=PR< J)/NZ 

1  1  99 

PROP 

( 3 1  »  =HOTM/NZ 

1  1  95 

PROP 

( 32 ) =RT9/NZ 

1196 

PROP 

1  3  3  3  »  TOPlI/NZ 

1197 

PROP 

(  39  )  =EV  A°M/.NZ 

1  1  98 

PROP 

(  35  1  =  Eit'3B  / N l 

1  199 

PROP 

(36  1  «C*!0«/N2 

1203 

PROP 

(  37  1  at-iOT/NZ 

1201 

PROP 

(381 atVAPCN/NZ 

1  202 

PROP 

( 39) a»0T«U/N2 

1203 

PROP 

(9Q)a  HTH'I/HZ 

1209 

PRUP 

(9l)aTOPMO/NZ 

1205 

PROP 

( 92 1 =  EV  APMU/NZ 

1  205 

PROP 

(93)=>B0TMV/NZ 

1  207 

PROP 

(99 (aRTNV/NZ 

1  209 

PROP 

(9S)aT0P1Y/KZ 

1209 

PROP 

(96laEV4P.(Y/N2 

1210 

PROP 

( 97 ) aEQB/NZ 

12  11 

PRUP 

(98 1 aEOR/NZ 

1212 

PROP 

(99)aS0T/NZ 

12  13 

■v R  i  rr 

(6,5101  uR.73  ,  T  ,«(CiPROPl  I  )  .PROP  I  2  >  .'NEC  YCL  .  PROP  t  5  >  .PROP  (  6) 

12  19 

6  R  1  T  E 

(6.59Q)  (PROP  1 J)  »  J ■ 7 , 9  9  > 

12  15 

60  TO 

270 

12  16 

253  *RITE16,S30>  PROS , T , MC . E TH , ECK , NEC YCL . E ZPH2 , BBOuND 

1217 

*R  t  T  E 

(6.590)  (9,(P0(H,J),  J* 1  .  8 )  ,  Mal.NMAT) 

12  18 

write 

(6.595)  (PO(NV'JIO.J)  .  J»1.8),  BOTM.RrM.ToPM.EVAPM.EMOB, 

12  19 

1  EM0R,EMOT,EVAPER,30rMUtitrtlU,T0PMU,eVAPMU,8OTMV,RTMV,T0PHV, 

1220 

2  E  V  A  p  M  V  1  EOb  ,  f.or  ,eot 

1221 

270  CONTINUE 

1222 

C 

...  energy  totals  stored  for  later  USE  IN  TRACER  point 

1223 

C 

PLOTS, 

1229 

- 

X  1  EnR 

'imP  3  <  UvO  t  3 . 1  ) 

1225 

X < E n R G 3 P 0 f  NVO  t  o  ,  2  ) 

1226 

X TENRoaP  }  ( NVQ t D i 3 1 

1227 

C 

•  (3  THIS  A  TAPE  DUMP  OR  RE  ZONE  CYCLE 

1  228 

JF  (NUM$?T«EQ«ritUJ;if’7*0rt  $  (ft&Z«NE«Q*  •aNO»HEZFCT  •NE«0*.AN0«NUMKEZ*GT 

1229 

|D))  GO  T’J  (50 

1  2  30 

c 

•  ••  PR[S|T  COORDINATE*  °F  BOUNDARY  TRACERS  FOR  EACH 

1231 

c 

material  package. 

1232 

280  WRITE 

(6,590) 

1233 

00  .3  30  N 3  t  ,  (9  M  A  T 

1239 

NPaijpp  (  N  ) 

1235 

rt  R  I  T  E  (  6 , 5  I  0  1  N 

1236 

330  *RI  TE  1  6,6!30>  (L.  TXIm.lI.  TY1N,L)i  L»1»NP) 

1237 

c 

...  PRJ.JT  COORDINAIES  Of  F R);E  SURFACE  TRACERS. 

12  33 

f.|  p  =  ,g  n 

(  N  V  0  1  3  ) 

1  239 

WRlTE(6,6l3l 

1  290 

W  R  1  TE  1  6,830)  t  L  >  T  X  (  N  YOl  0  *  L  1  *  TY(NVOIi)»l-).l."l,NPI 

129  1 

c 

•  «*  If  SYMTiOL  IC  CON  Ton1?  A  APS  OF  C  OMPRfSS  I  ON  .  PH  £.5  SURE* 
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1  2*42 

C 

VFl.OClTV,  and  INTERNAL  ENERGY 

12*43 

IFlMAPS.GT.Ol  call  map 

12*4*4 

C 

short  print  means  13«i  and  properties  are  printed  only 

1  2*45 

c 

T09  CELLS  IN  FIRST  COLUMN.  LONG  PRINT  MEANS  13*11  AND 

12*46 

c 

PROPERTIES  ARE  PRINTED  FOR  ALL  CELLS  IN  ACTIVt  GRID* 

1  2*47 

370 

DO  920  1*1.1 3 

12*48 

KSPACE“0 

l  2*49 

SFL  AGP ■ 1 • 

t  250 

J  ■  I  2  ♦  1 

12S1 

K«  1  2« | MAX* 1  +  1 

1252 

00  *410  L*l  .  12 

1253 

J*J-I 

12S-4 

K»K-IMAX  | 

1  255 

375 

MFK=MFLAG<K)  j 

1  256 

380 

IF  (6FLAGP.EQ.0. )  50  TO  39U  , 

1257 

6R  I  T  E  (  6  i  5 6 0  1  1  ,  X  (  I  |  ,  0 X  (  I  ) 

1  259 

6R I TE 1 6,5*5) 

1  259 

•Y  F  L  A  G  P  *  0  •  . 

1260 

390 

*S»AMX«K*71TAU1 1 »*Dyl J) ) 

126  1 

MN.O 

1  262 

V*S  A  >0  . 

1  2*3 

I F ( MFK • GT • 1 00  .OR.  MFK.EQ.Ol  60  To  3’5 

1  26*4 

MN=MAT 1 MFK > 

1265 

*SA  =  .VS/WHO  IN  II1FK  1 

1266 

1.  F  (MN.EQ.20)  GO  TO  395 

1267 

ASA  «  AS/RH07.  (MN) 

12*9 

395 

AlRIT£(6,520>  J.MFK .U(K» , V(K» ,PIK 1 , \ IXIK1 iWSA, AMX1K 1  .STHSZZ IK  »  , 

1269 

STRSKRCK),  STRSKZ(K) ,Tl J» 

1270 

IFIMFK.LT. 100)  GO  TO  398 

127  1  • 

M=HFK-inJ 

1  272 

RR  I  TE  (  6 , 6  3CJ1  RHO(NVOID.M) 

1273 

DO  397  N=1  .NMaT 

1  27*4 

MR  *  MATIN) 

1275 

bSA«XMASS(N,M)/RH0(N,H1 

1276 

<VSA  =  'AiSA/ITAU(T>*OTtj)) 

1277 

ASC  =  RHO(N,M)/RllOlH(Nt 

1278 

1  F  1  mN  .E<3  •  20  )  GO  TO  396 

1279 

ASC  =  RH0<N,M1/RI402  1MN) 

1280 

396 

CONTINUE 

128  1 

liR  1  T  E  t  6,6  201  ntJ.NSA.RMOnl.tl)  .SIE  .WSC  .XMASSIN.M) 

1282 

397 

CONTINUE 

1283 

;«R  1  TE  1  6 ,565) 

128*4 

398 

CONT 1 NUE 

1  2B5 

KSPACF-aO 

1286 

'4  1  0 

CONTINUE 

1287 

**20 

CONTINUE 

1  288 

IF  INPKINT.EQ.il  60  TO  130 

1289 

ASSIGN  1 30  T»  1  OCA 

1  290 

ASSIGN  |30  Til  LOCH 

129  1 

IT  (PKOELT.Nf.O. >  GO  TO  50 

1292 

go  to  inn 

1293 

C 

PRINT  DLLTa  mot  SPrCiriED  IN  INPUT 

1  29*4 

*4  30 

II  N  *  *i  5 

1295 

GO  TO  *4  6  U 
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•**  ENERGY  CHECK 


1294 
1  297 
!  29ft 
1299 
1  300 
1301 
t  302 

1  30  3 
I  3  0  S 
1  305 
1306 
1  307 
1  30ft 
1  309 
13  10 
(311 

1312 

1313 
1  3  I  ft 

1315 

1316 

1317 
13  16 

1319 

1320 

1321 

1322 

1323 
132ft 
I  325 

1326 

1327 
1  328 

1329 

1330 

1331 

1332 

1333 
133ft 

1335 

1336 

1337 

1338 

1339 
1  3  ft  0 
1  3ft  1 
I  392 
1  3ft  3 
I  3  ft  ft 
1  3  ft  5 
1  3  ft  A 
1  3H7 

I  3  ft  8 
I  3  ft  9 


C 


ft  <10 

N  K  ■  1  3  0 

GO  TO  ft  60 

ft  60 

NH-5 

CALC  ERROR 

870 

RFC  A  6f>»0  • 

WFLAGFbO* 

C  •••  SHOULD  GRID  llE  REZONFO  nN  THIS  C*CLE 

IF<1(PEZ«NE.0..AN0»PEZFCT»NE.0.)»0R.5S*».Ne.0.|. aNP.nUMREZ.6T  .0  ) 

1  GO  TO  ft  80 
RETURN 

ft8U  CALL  REZf'NE 

C  •**  HOST  CALL  COT  TO  RECALCULATE  PRESSURES 

T  N  0  ti  =  T 
OTHOW.OT 
RE  2  *0 » 

SSft«0. 

CALC  COT 
T  »  T  NOW 
OT  =  otmow 
dtna=dt 

NUMKE7  =  NUmRF.Z- 1 

c 

c  •••  NRE  7  *  NUMBER  OF  RCZONES  ALLOWED  (INPUT  VaLUE  OF  NUmREz) 

C  .  M U M R E 2  •  NUMBER  OF  »EZONf S  ALLOWED  MINUS  THE  NUMBER 

C  OF  REZ0NE5  PERFORMED  SINCE  T»0. 

C 

NKZaNREZ-NUMREZ 

C  •••  NZ  USEO  in  PRINTOUT  OF  TOTALS  FOR  1 -P  PROBLEMS 

N2*ft.»»NRZ 
C 

NUH5PT-N0UMP7 
GO  TO  170 
C 

C  FORMATS 

C 

S(0  FORM AT1/9H  PACKAGE  .12/  7X»  5 1 6X » 1 hN . 6 X , l H X  ,  7 X » 1 H Y ) / 1 
S20  F0RMATlIft,15,lX,lPftE17»ft»lPEl3.S,lPftE12.ft,lPE9.3l 
530  FORMAT  I 8H 1 PPOpLEM ,6x ,ftHt I  HE ,8X .SHCYCLE • 3X , 1 3HT0T  »EN. THE  OR . 3X • 

1  19HMAX. PEL. ERROR-CYCLE .3X , IBHJE  SET  TO  ZER0-PH2.3X, 

2  20H ELASTIC  PLaSTIC  WORK / 1 F 8 . ft  ,  2 X  ,  I  PE l 3 . 7  . 

3  !7.]PE17-7,E16.7.!5,El9.7tE21.7/) 

SftO  FORMAT  (12H  PACKAGE  NO .» 6 X , 2H I £, 1  ft X , 2HK E » 8 X  ,  1 3HT0 T  . EN •  <SUM»6X, 

1  ftHMASS .  1 2  X , 2HMV , 3  X ,  | 2HHV (POSITIVE)  ,  8X  ,  2HMU ,8X.12HrLASTIC-k'.0RK/ 

2  (IH  ,I5,5X,!P8E1S,7)> 

Sft5  FORMAT  (  l  ftX  1  8  (  I  2H - - - ,3X)/  7H  TCT  AL  S  ,  ft  X  ,  1  P 

SBEI5. 7/7/9 H  AnUHDAKY, 9 X.6H BOTTOM *9X«5H RIG MT,10X,3HTOP|8X,l2HSEVApO 
6RATE05//9H  MASS  OUT  ,  2X  »  1  Pft  E'l  5 . 7/ 1  |  H  ENERGY  OUT  .  1  P  ft  E  )  5 . 7  /  7  M  MU  0U| , 
7  ft  X  1  I  P  ft  f.  (  5 . 7  /  7  m  H  V  0UT,ftX»!PftE15»7//|tH  WORK  DONE  ,lP3Elb,7//l 
S50  FORMAT  (IH0//7IH  TAPE  7  DUMP  ON  CYCLEIb////) 

5ftn  FORMAT  (  1  H  /  /  /  ft  H  I  *  I  3  1  6  X  t  6  HR  lit  =F  1  2  •  3 , 6  X  ,  7  Hf)R  (  I  )  =El‘t.7//T 

GAS  FORMAT  <  /  3H  J,7H  MF  l  A  G  ,  6  X  >  1  HU  ,  l  |  X  ,  1  H  V  ,  1  l  X  •  1  HR  ,  1  0  X  ,  3HS  I  E  1  9  X  1  ft  HC  0  r,P 
1  MX,  SHTMASSi  8X,  3ri5Z/-.  9X,  3HSRR.  9%,  3HSR2.  9X  ,  1  HZ/) 

570  FORMAT  ( I  MO ) 
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1360 

1361 

1352 

1353 
1359 

1355 

1356 

1357 

1358 

1359 
1  360 
136  1 

1362 
'  1363 
-  13  6  9 

1  365 

1366 

1367 

1368 
1  369 

1370 

1371 

1372 
1  373 
l  378 

1375 

1376 

1377 

1378 
l  379 

-  1380 

138  1 
1  382 
1383 

1389 
1365 

1386 

1387 

1388 
I  389 

1390 
1  39  l 
13  92 
1393 

139  9 
1  395 
l  396 

1397 

1398 
1  399 
1  900 

1901 

1902 

1903 


580 

590 

600 
6  |  0 
620 
630 


FORMAT  1//22H  J  OF  PRESSURE-MAX1HuM/<2515)  > 

FORMAT  1 //30X ,  53HCELL-C00RU INATeS  OF  TRACERS  FOR  EACH  MATERIAL  PaC 
IK  AGE/  I 

FORMAT ( 9X , 16 . 7F«. 2 i 16 ,2f8»2 » I  6 ,  2F8.2.  16,  2f8.2»  16,  2FB.21 
FORMAT I  /  2  l  H  FREE  SURFACE  TRACERS/  7X,  5 ( 6 X , 1 HM , 6 X , I HX , 7 X , l HT > /  > 
FORMAT (16X. I  9 , 7X  ,F6 . 3 ,9X , l P9E 1 3 .5 ) 

FORMAT (  16X ,5H  MftT  .SX.IOHFRAC.  VOL . ,7X ,3HRH0 , 10X ,3HS IE  ,9X  , 

I  9HC0MP  ,9X  .9HMASS.9X  ,13HRH0(MV0ID  ,M)  =  ,F3»  l1) 

ENO 

SUBROUTINE  ECST 

C  **♦  COMPUTE  PRESSURE  'AS  A  FUNCTION  OF  ENERGY  AND  DENSITY 

C  USING  THE  TILLOTSON  EQUATION  OF  STATE,’ 

INCLUDE  COMpiM 

DIMENSION  eSAOO),  ES9130),  ESCAPA  (  30  )  ,  ESC  APB  (  30  )  ,  ESEZOOI, 

1  ESALPH130),  ES0ETAI3O),  ESES 130),  FSESP<3n) 

C  | 

c  MATERIALS  ® HOSE  EQ.  OF  STATE  CONSTANTS  ARE  SPECIFIED 

C  JN  THE  FOLLOnlND  DATA  STATMtNTS 

C  1  -  TUNGSTEN  ( Xi  1 

C  2  -  COPPER  ICUI  ; 

C  3  -  IRON  (FE) 

C  9  -  ALUMINUM  (ALI 

C  5  -  BERYLLIUM  (BE  I 

c  6  -  TITANIUM  ( T | > 

c  7  -  NICKLE  (Nil 

C  8  -  MOLYBDENUM  (MOI 

C  9  -  THORIUM  (  TH)  -  . . 

C  10  -  LEAD  (PB1 

c  I  1  -  polymers  .  .  . 

c  12  -  GRANITE 

C  13  -  ANDES  1  TE  -  . . -  !  - 

C  19  -  WET  TUFF 

C  IS  -  DRY  TUFF  ;  . . 

C  16  -  OIL  SHALE 

C  17  -  DOLOMITE 

C  18  -  LIMESTONE 

c  19  -  haute  .  .  . 

C 

DATA  (ES AIK}, *31,19) 

I  /  9  •  «  5  ,  .55,  3  •  .  5  ,  2  •  •  9  ,  8 1  •  5  / 

C  . 

DATA  (ESBCK) ,<>| , |9) 

1  /  1.09,  2*1.5,  1.63,  .62,  .60,  1.33,  I»02,  ,86,  2.9, 

1  2.0,  9*1.3,  1.0,  3*. 6/ 

C 

DATA  (ESCAPA (K 1 ,K* 1 , 191 

1  /  3  «  0  rt  E  1  2  »  1  .  3  9  E l 2 ,  |  .  2  6  E  1  2,  ,75E12,  1.I7E12,  1.03e12" 

1  1 • 9  1  E  1  2  ,  2 .7 1 E l 2  ,  '  * 

?  .34E12,  . 1 OE  1  2  , 

3  • 25 E  l  2  / 


9600 


9620- 


•  r. 


53E12,  , 9  6  ft  E l 2  ,  .  075E12,  .60E12,* 
•  09SE12,  , 2  BE  I  2 ,  .85E12,  ,9el2, 


OATft  (ESCaPBU 1  •  K ■  1  ,19) 


/  2 


i i  m 

.5E12,  1 • 1 E 1 2 ,  1.05E12,  .65E12,  .55E12,  *5E12, 
1.5EI2,  1.65E12,  .5E12,  .15E12,  .02E12,  0.0, 
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1  908 
1905 
M06 
I  907 
Moa 
1909 

mo 
m  i 
m2 

1<*13 
MM 
1815 
MM 
M  1  7 
M16 
MM 
M  20 
M  2  1 
M22 
M23 
1929 
M25 
1924 
M27 
M  28 
M  2  9 
M  30 
M  3  1 
M  3  2 
M  3  3 
M3*t 
t  83S 
M3& 
M  3  7 
M  38 
M  39 
M90 
199  1 
1892 
M  8  3 
1989 
M9S 
1996 
19  9  7 
I  898 
1999 
19S0 
MSI 
1852 
MS  3 

I  859 
MSS 
M  5  6 
MS7 


2  .28E12,  « 06E 1 2  ,  ,03ei2,  .11E12,  .30E12,  *47E1 2, 

3  »  30E 1 2/ 

C 

DATA  1ESE2IK) ,K«1 , 191 

|  /  <  225E 1 2 ,  .325E12.  «09SEl2*  ,0SE12,  ,|7Sei2,  ♦07EU, 

1  .09E12,  ,08Se12,  .02SE12,  .02E12,  ,07E12,  .16EU, 

2  •  1 6E 1 2  ,  # 1 1 E 1 2  i  •  O&E  1  2 (  .  1 1 E 1 2  ,  , 1 0E 1 2  ,  .10E12, 

3  . 0  SE 1 2/ 

c  - . 

DATA  <  ES AL PH  f  <  >  iK“1 ,19) 
i  /  10«,  7  *5  •  *  9.,  2* 1 0 «  i  8  *S  •  / 

C 

DATA  <ESBETa<K) ,K»1  ,19)  . . .  • 

1  /  I  0  .  «  7*5##  #88#  2a  |  9,5,/ 

C 

DATA  (ESEStKl  ,<=»!  ,19) 

-•  1  /I.llEin,  l . 38E 10.2.99E 10  ,  3.0E10,  10. 0E10.  3.5E10, 

1  2  •  3  5  E  I  0  ,  2#8E  1  0  ,  2MEI0.  .26EM.  2.9E10,  2*3.5E10, 

?  3«3,2E10,  2*2  » SE 1 0  »  2.0E10/ 

C 

DATA  <ESESP<I<1  ,K«1  ,  19) 

1  /  5.6EI0,  6.9£|0,  10.2EM,  IS. OEM,  96.0E10,  12.5E10 

1  9 , 9  £  1  0  «  <?,  OEM,  e. OEM.  •  9  7  E  1  2  ,  18.0E|2,  2»,»8EI2, 

2  .  |AE  |  2  ,  ,  1  8£  1  2  ,  .I6E12,  2»*ME12.  MSE12/ 

C  •••  IS  MATERIAL  n  an  ideal  gas 

IFIN.EQ.20)  GO  TO  30 

C  ••*  STOKE  CONSTANTS  FOR  MATERIAL  N. 

A=ESA(N) 

B*ESB(N) 

CAPA*ESCAPA(Nl 

CAPBbESCAPB ( N )  ' 

C  •*•  CAPS  (S  TENTATIVELY  SET  TO  -C APB  WHEN 

C  RHOA  ,LT.  RHOZR  IN  A  MUEO  CELL  (WS«-1.) 

IFMS.LE*“>  •  I  CAPB*-CAP8 
EZ  -  ESE7MJ 
ALPHA  =  ESAlPh(N) 

BETA  »  ESBETA (N) 

ES  »  ESE5(N) 

ESP  *  ESESPfM 

RHOZR  =  KH07(M 

IFIRHOZR.LE.O. )  GO  TO  80 

«SaESP-fS 

IFI»SiLE>0, 1  <VS*1  • 

SSMl./AS 
E  T  A  ■  /  RhOH/RHO 29 
IFIETA.LL.O.  1  GO  TO  80 
VO<V  ■  1 ./ETA 

EXPMtN=  1.  -  CAPA/  1  APS  (  CAPB*CAPti  1  1 
IFI.EXPM  [N.LEM.  >  CAPS*  APSICAPB) 

C 

IFIENERgT.LE.C.  1  GO  TO  20 
C  *••  PI,  P9  »  THERMAL  PRESSURE  TERMS. 

PMEN£R6T«RP0i>'»A 

P9«B/(ERERGY/(EZ»ETa*»2)*1. )• ENERGY • R HOR 
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t  *»  &  a 

C 

•  ••  PS  ■>  mechanical  PRESSURE  term.  ; 

itst 

10 

P5»CAPA» t ETA- 1  •  1 

1  **60 

P2«-t, 

1  t  i  1 

c 

•  IF  RHOA  ,LT.  RhOZR  AND  energy  |S  BETWEEN  eS  AnU  ESP, 

1  *4*2 

c 

A  COMBINATION  OF  THE  EXPANDED  and  condensed  equations 

1  ti3 

c 

of  state  IS  usco. 

1  ‘(it 

1  F  <  ETa.GE. 1 . 1  GO  TO  SO 

1  t  AS 

c 

•  ••  ESP »  ENERGY  TO  V  APOR I  2  E  MATERIAL,  MUST  EXCEED  ES. 

1  tii 

IF (ENERGY ,6T .ES»)  GO  TO  to 

1  ti7 

c 

•••  E5  =  ENERGY  TO  ORING  MATERIAL  TOiVAPOK  TEMPERATURE. 

1  tie 

If (ENERGY .GT. ESI  P2.1. 

1  tit 

c 

P2  »  I •  SIGNALS  USE  OF  BOTH  EXPANDED  AND  COMPRESSED 

1 1 7  0 

c 

FORMULATIONS.  OTHERWISE  P2=-l. 

1 1 7  l 

GO  TO  50 

1 1 7  2 

c 

♦  THERMAL  PRESSURE  TERMS  m  0.  WHEN  ENERGY  IS  ZERO  OR 

1  t73 

c 

NEGATIVE. 

1  t7t 

20 

Pl«0. 

1  t  75 

Pt«0. 

1  t  7  i 

IF(MFK.lT. 100  <  AND  •  ETA.LE«AMdH(MFK) )  GO  TO  60 

1  t  7  7 

GO  TO  Ifl 

1 178 

c 

IOEAL  GAS 

1  t79 

10 

PRESUR  .(gamma-1 . )*RH0A»ENER6T 

1  S80 

60  TO  90 

I  tS  1 

c 

•  •••  expanded  state . 

1 182 

to 

P8.( I ,-VOA) 

1 133 

p9=EXP(ALPHA.pai 

1  t8t 

P12«EXP(-ftETA*H8*.2l 

1  tas 

PRESUR»PI+(Pt+P5*P9(«PI2 

ItBi 

IF(P2.LT.O. |  GO  TO  70 

l  H87  - 

P  1  =SS 1 • ( ENERGY-E5  1 

l  taa 

PRESUR  «  P  1  .PRESUR* ( l .-P 1 1 »P3 

1  tR9 

GO  TO  70 

1  t  90 

c 

•  IF  (26-4l/(2d*AI  .ET.  RhO*  »LT.  RHOZR  A  No 

1  t9  1 

c 

THE  CELL  IS  MIXED  (CAP9.LT.01,  linearly 

1  t92 

c 

DECREASE  CAPB  BY  A  FACTOR  BETWEEN  -1  AND  ♦ 1 • 

J  t93 

c 

IF  R  HO  A  ,LT.  ( 28-A 1 / ( 2B*A )  LEAVE  CAPB 

1  t9t 

c 

UNCHANGED,  VIZ.,  C A P B ■ - A B S ( C A P B 1 . 

1  t9S 

50 

IF(CAPB.L'f.0..AN0.EXPMlN*V0*.LT.2.-EYPMINI 

1  t96 

I  CAPU*CAPB»U.-EXPH(N*VOW)/(EXPMlN-l.) 

1 1  97 

P6  =  CAPB»<  IETA-I. 1 »*2) 

1  t98 

P7api*P5 

19  99 

c 

♦  PRFSSlI.Tt  PLATEAU  FOR  PURE  CELLS  THAT  A R £  UNDeROENSe 

1500 

c 

AND  COLO, 

1501 

IF  I  MFK.LT. 100  .ANO.  ETA.LT.EXPMINI  P  7.  ,5.CAPA.(EXPmIN-1.) 

150  2 

PRESURsP 1 ♦ P  t ♦ P  7 

1503 

IF(P2.LT*0.»  r,0  TO  iO 

1  5Ut 

c 

•»«  USING  COMBINATION  Of  CONDENSED  AND  EXPANDED  EQUATIONS 

1505 

c 

OF  STATE, 

1  50i 

P3«pRESUR 

1507 

GO  TO  to 

1508 

c 

•  •»  using  CONDENSED  EQUATION  of  STATE.' 

1509 

iO 

IF ( PRESUR.GE .0.  )  GO  TO  90 

1510 

c 

•  AMEN  USING  CONDENSED  ED.  OF  STaTE.i  SeT  P»Es,jR  *  0 

15  11 

c 

IF  MATERIAL  IS  EXPANDEOIfTA.LT, aMOM) ,  OR  IF  J.LT.N6. 

30 


1512 

C 

I  N  6 

IS  INPUT  PARAMETER). 

ISU 

IF<  I9FK 

.I.T.  103 

.  4  NT) .  (  J  •  L  E  •  N  6  .OR.  ETA.LE.AMOM(NFK)  >1  GO  TO  80 

1S|9 

GO  TO 

90 

' 

15(5 

c 

•••  ALLOT  NEGATIVE  PRESSURES  ONLY  WHEN  USING  CONDENSEO 

1516 

c 

£Q  » 

OP  STATE. 

1517 

70 

IMPRESUR.Ge.O 

.  .OR,  MFK.GT.10D)  GO  to  90 

ISIS 

80 

PRESUR 

«  0. 

1519 

90 

RETURN 

1520 

ENO 

1521 

SUBROUTINE  ERROR 

1522 

c 

PRINT  ERROR  MESSAGE  and  cell  QUANTITIES  before 

1523 

c 

exiting  On  AN  ERROR  CONDITION  DETECTED  by  the 

1529 

c 

PROGRAM. 

1525 

INCLUDE  COMOtM 

1526 

c 

1527 

IF  ( N E  R  R • E  U  .  1  1 

r.O  TO  9  20 

1  52a 

GO  TO 

n 0,20. 30 ,90,50.60, 70.80,90 , 1 00 1  1  10. 120 , 1 30 . 1 90 >  « NR 

1529 

10 

WRITE 

(6.210) 

NX 

1530 

GO  TO 

9  1  0 

1531 

20 

A'R  1  TE 

1 6 ,220  ) 

NK 

1532 

GO  To 

9  1  0 

1533 

30 

WRITE 

(6,230) 

NK 

1  539 

GO  TO 

9  1  0 

1535 

90 

WRITE 

(6.2901 

NK 

1536 

GO  TO 

9  10 

1537 

50 

WRITE 

I6.250J 

NK 

1 5  3  a 

GO  TO 

9  1  0 

1539 

60 

WRITE 

(6,260) 

NK 

1590 

GO  TO 

9 1  a 

1591 

70 

WHITE 

(6.270) 

NK 

1  592 

GO  TO 

9  1  0 

1593 

80 

WRITE 

( 6 . 260 ) 

NK 

1599 

GCI  TO 

9  l  0 

1595 

90 

WRITE 

(6.290) 

NK 

1596 

GO  TO 

9  I  0 

1597 

1  00 

WRITE 

( 6 .300 ) 

NK 

1598 

GO  TO 

9  I  U 

1599 

1  10 

WRITE 

(6.310) 

NK 

1550 

GO  TO 

9  1  U 

1551 

1  20 

WRITE 

(6.320) 

NK 

1552 

GO  TO 

m  i  n 

1553 

130 

WRITE 

(6.330) 

NK 

1559 

GO  TO 

9  10 

1555 

190 

WR  1  TE 

16.3901 

NK 

1556 

GO  TO 

9  1  0 

1557 

9  1  0 

WRITE 

(6.350) 

1 ,J.K, CM.Z1M)  ,ZCM)  ,Mal  ,160) 

1558 

c 

•••  IF 

pip»i,  error  is  In  input  deck 

1559 

IFlf.R. 

EQ . 1 1  GO 

TO  920 

1560 

c 

•  ••  IP 

NRb5  AMD  NK«130»  EDIT  PRINT  HAS  JUST  BEEN  DONE* 

1561 

c 

SETTING  ERoUHPb  I  .  ,ED  I T  »ILL  DO  a  TaPE  DUMP  BUT  NOT 

1562 

c 

ANOTHER  PRINT. 

1563 

I  F  l  P  L  A  G  L  .  G  T  .  0 

.)  GO  TO  9  ?C 

1  569 

IF  IN  R 

.E0.5.AH.0.NK.FG.  130)  F.R0UMP»1  . 

1565 

H  E  R  R  = 

1 

B* 
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1566  13-11 

1567  NPR1NT-1  i 

1568  V.FLAGL-I.  i 

1569  NUMSPT-NDUMP7 

1570  CALL  FDIT 

1571  **70  CALL  EXIT 

1572  C 

1573  C  ’ 

tS79  210  FORMAT  ( 1 H 1 , 5 X . 3 8 M • • •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,I5*10H  IN 

1575  |  INPUT  | 

1576  220  FORMAT  ( 1 H 1  ,SX  ,3flH»»»  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,I5*I0H  in 

1577  I  SETUP  ) 

1578  730  FORMAT  ( I H 1 , 5 X , 3 B H • « •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,I5»I0H  IN 

1579  1  COT  )  ; 

15P0  290  FORMAT  < t H t  » 5 X  ,  3 6H» » •  ERROR  EXIT  -  SEE  STATEMENT  NUM8EN  .jS.lOH  IN 

1581  1  ES  ) 

1562  750  FORMAT  ( 1 H 1 , 5 X , J BH» • •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,Ib,IOH  IN 

1 5  P  3  t  EOIT  | 

1569  260  FORMAT  { I H t , 5 X , 3 8 H ■ • •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,I5,10H  IN 

1585  !  MAP  ) 

I5P6  270  FORMAT  (  1  H 1  , 5  X  ,  3  8  H«  *  •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,IS»lDH  In 

1587  1  PHI  ) 

1588  2B0  FORMAT  I  1 H 1  .  BX  ,  3Bh«  *  •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  .I-5.10H  IN 

1569  |  PHI  ) 

1590  290  FORMAT  ( 1 H l , 5 X , 3 8 H • * •  ERROR  EXIT  -  SFE  STATEMENT  NUMBER  ,I&,!OH  IN 

1591  I  1NFACE)  ! 

1592  300  FORMAT  (  1 H  X  ,57 ,3CH»«»  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  » 1 5  » l OH  IN 

1593  |  N E  A' M  |  x  ) 

1599  31 0  FORMAT  ( 1 H 1  ,  5X  ,  30H»» •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  .I5.10H  In 

15  9  5"  i  N  E  W  R  H  0  ) 

1596  320  FORMAT  ( 1 H 1  .  5 X  ,  3 8h • • •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  .iS.tOh  IN 

1597  1  FLUX  ) 

1SS8  330  FORMAT  ( lHl ,5X,38H*«*  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  .I5.I0H  IN 

1599  I  Ph?  | 

1600  390  FORMAT  (  1  H I  ,  5 X  ,  3 8 H • • •  ERROR  EXIT  -  SEE  STATEMENT  NUMBER  ,I5»I0H  IN 

1601  |  REZCNE) 

1602  35C  FORMAT  |//SX,6H  1 « , 1 3 , 6H  J«l7,4H  K *  I  3/ / 1 6 X , 7 H L “B L OC K / / 6 X , 

1  603  !15h  real  FORMAT  ,SX,ISH  INTEGER  FORM A T /2 X , 1 H l , 8 X , 9HZ 111  ,  I  7 X  ,  9H2 ( 

1609  2!)//tl9,2X.El5.6,5X,llsn 

16  0  5  E  N 0 

1606  SUBROUTINE  FLUX 

1607  INCLUDE  C0MD1M 

1608  C  *  •  *  *  • . .  COMPUTE  FLUXES  ACROSS  ToP  AND  RIGHT  BOUNDARIES  FOR  *••• 

1609  C  EACH  MATERIAL  ]N  A  MIXED  CELL. 

1  6  l  0  C 

16  11  MA«=MA-  l  00 

1612  MR=MR-100 

1613  C  •••  BEGIN  LOOP  GN  materials 

161  9  C 

1415  200  00  50  0  nT«  1,1-1  mat 

1616  V  A  B  0  V  f.  s  0  . 

1617  U  R  R  *  0  » 

1618  C 

1619  C  ♦  •»  IF  CELL  OCfSNT  CONTAIN  MATERIAL  N,  SKIP  nUT 
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1620 


1623 

142*1 

1625 

1626 
1427 
16  2  8 

1629 

1630 

1631 

1632 

1633 
1639 
1635 
1  636 
1437 

1638 

1639 
1690 
169  I 

1692 

1693 
1699 

1695 

1696 

1697 

1698 

1699 

1650 

1651 

1652 

1653 
1659 
1655 
1  656 

1657 

1658 

1659 

1660 
166  1 
1662 
1663 
1669 

1665 

1666 

1667 

1668 

1669 

1670 
167  1 

1672 

1673 


C 

IF  I RHO (NT  ,M)  .IE.O.  1  GO  TO  500 

C  CALCULATE  flux  OF  MATERIAL  n  ACROSS  TOP  BOUNDARY. 

C  IF  CELL  ABOVE  DOESNT  CONTAIN  MATERIAL  N,  SKIP  OUT. 

c 

R  HO  A  *  0  . 

IFlJ.EQ.JMAX  .ANO.  VfICJ.GT.O.)  60  TO  230 
IF1J.EQ.JM AX  .AND.  V1KI.LE.0.)  GO  TO  3G0 
C 

1F1MA.GT.C  )  60  TO  21C 
C  CFLL  ABOVE  PURE 

IFlMA+100  • NE •  NT)  GO  TO  3C0 
RHOA  «  AMX ( KA ) / < T AU ( 1 ) «0Y 1 J+ 1 ) ) 

VC  =  TAU<  I  » • 0  T  <  J* I  I 
GO  TO  22 0 

C  CELL  ABOVE  MIXED 

C  »••  RHO(NT.Ma)  »  C.  INDICATES  CELL  DOES  NOT  CONTAIN 

C  MATERIAL  M. 

210  IFIRHOINT.MAl.LE.O.)  GO  TO  300 
RHOA  *  RHOIN'T.MA) 

VC*XMaSS(NT,Ma)/RHOa 

C  |F  CELL  ABOVE  CONTAINS  A  FREE  SURFACE.  SfT  IFS2-1 

I FS2  *0 

1 F 1 RHO ( NV0 ID  ,MA )  .GT .0.  )  IFS2  ■  1 
IF ( AMX ( KA 1  • LE.C  .  I  GO  TO  23C 
270  IF  1 AMX  1  K  )  .LE  .0.  )  GO  TO  235 
WSA= 1 V ( K  >  +V  1  KA  ))  *  .5 
WS  =  DT/OY ( J  I 

W  SB  *=  I  .0*  <  V 1 KA  > -V (K>  I  *'AS 

IFt  ABSIVIK)  )*V-S.GT.STAD  .OR.  ABS(VlKA)  I  *  A  S  .  GT  ,  ST  AB  )  WSB-t.O 
VABOVE  B  6  S  A  /  A  S  B 
GO  TO  2 80 
230  V  APOVF  »  V  (  Y.  ) 

GO  TO  290 
J3S  VABOVE*V(KA) 

C 

C  »••  IF  ONLY  ONE  CFLL  CONTAINS  A  FREE  SURFACE.  USE 

C  OENSITY  OF  THE  OTHER  ONE  TO  DEFINE  THE  MASS  FLUX. 

290  1 F ( AfiS I VABOVF )  .LE  .UH 1 N )  GO  TO  3nO 

I  F  1  V  ABOVE  .GT  .C  .  .AND.  X M A5S ( N T  ,  M ) . LE • 0 . )  GO  TO  30U 
1F1MA.LE.0  .OR.  J.EG.JMAX)  GO  TO  295 

IF IVAbOVE.LT.C.  .AND.  XN A SS I N T  ,  H A  )  .  L E  .  0  .  )  GO  10  300 
IFt IFS1 .GT . IFS2)  GO  TO  2ST 
I F 1  I FS2 . GT .  1 FS 1  )  GO  TO  260 
C 

c  ...  if  BOTH  OR  NEITHER  CONTAIN  a  free  SURFACE  USE  DENSITY 

C  OF  DONOR  CELL  TO  DEFINE  MASS  FLUX. 

C 

?MS  I F 1 VABO VE . GT . C • ) GO  TO  26C 
1  F 1 J. E Q, JMA X )  GO  TO  30C 
2«.Q  RHOT  s  RHOA 
GO  TO  270 

260  RHOT  s  RH01NT.M) 

VC=XMASS(NT,N)/RhOT 
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l  679 

C 

■j 

1475 

C 

•  ••  ACCUMULATE  FLUXES  ACROSS  TOP  BOUNDARY 

1674 

C 

1477 

270 

SMPr«RHoT»VABoVf»FRACTP(NTtH|»SDT»CYC 

1678 

WSeCY  CmX/CY  C  *  A  B  S 1 SMP  y ) 

1679 

IF(»S,LT»ROFPS»RIIOT*VC)  SMf‘Y»0. 

1680 

SAMPY<NT,M)oS'?PY*SAMpY<NT,M) 

1681 

C 

■; 

1682 

C 

•••  CAlCULATr  FLUX  OF  MATERIAL  N  ACROSS  RIGHT  BOUNDARY. 

1683 

c 

IF  CELL  ON  RIGHT  DPESNT  CONTAIN  MATERIAL  N  SKIP  OUT. 

1699 

c 

1  6  9  5 

3  0  U 

RHORoO. 

1486 

IF1I.EQ.IMAX  .AMD,  U  <  K  >  •  (i  T  •  0  .  I  GO  TO  330 

1667 

IFfl.rq.lKAX  .AND.  IJIK1.LE.0.I  GO  TO  500 

1668 

IF1MR.GT.0I  GO  TO  310  _  i 

1689 

c 

•  CFI L  ON  RIGHT  PURE 

1  690 

I F ( MR  +100  .RE,  NT)  GO  TO  500  • 

1691 

RHOR  s  aHX(kR)/1TAU(I*1).|)T(j|( 

1692 

VC»T  All  l  I  ♦  |  )  *0y  1  J  l 

1693 

GO  TO  320 

1699 

c 

CflL  ON  RIGHT  MIXEO 

1  69S 

c 

•••  RHOlMT.MRlaD.  INDICATES  CELL  DOES  NOT  CONTAIN 

1  696 

c 

MATERIAL  NT. 

1697 

3  1  0 

1  F  1  RHO ( NT , MR  1  .LE.  0.)  GO  TO  &00 

1698 

RHORerHOINT.MR) 

1699 

VC  =  X Mass  1 N T , HP  I /RHOR 

1  700 

c 

»•»  IF  CELL  ON  RIGHT  CONTAINS  A  FREE  SURFACE  SET  IFS2*1 

1 7  a  i 

I FS  2  *0  ) 

1702 

IF (RHO(MVoID,MR) ,GT ,0, )  I F  S  2  «  1 

17  0  3 

I  F ( AMX ( KR 1 «Lf .0. 1  GO  TO  33C 

1  709 

320 

I  F ( AM  X  t  K )  • LE • C .  )  GO  TO  335 

1  705 

6  S  A  s ( U 1 K I +U1KR1  1 » .5 

1704 

V.  S  =  0  T  /  p  X  (  II 

1707 

afSa«i.o*(u<KR)-(j(K))*.>s 

1  708 

IFtAHSlUlK) >*PS.GT.STAB  .OR.  A B S < U ( K R  )  )  • A S . G T . S T A B  )  WS6-1.U 

1  709 

URR  =  WSA/M’SB 

17  10 

GU  TO  3  9  U 

17  11 

330 

URR  =  U(K) 

17  12 

GO  TO  39 U 

17  13 

335 

URR=U(KR> 

17  19 

c 

* 

1  7  IS 

c. 

•  IF  Only  ONE  CELL  CONTAINS  a  free  surface. USE  DENSITY 

17  14 

c 

OF  THE  OTHER  CELL  To  DEFINE  MASS  FLUX. 

17  17 

3  90 

IF (ADSluRRI .LF.UNIN)  GO  TO  500 

17  18 

IFIURR.gT.O.  ,ANp.  XM ASS ( NT , M ) . LE . 0  .  I  GO  TO  500 

17  19 

IF  (MR.LE.O  «0i?.  litO.IMAX)  60  TO  395 

1720 

IF  IURR.LT  .1).  .AND.  XflASS  (  NT  ,MR  )  .  LE  .  0  .  )  GO  TO  500 

1  72  1 

1F1IFS1.GT.IFS2)  GO  To  350 

1  722 

1F1IFS2.FiT.1FS1)  GO  TO  360 

17  23 

c 

17  29 

c 

...  [F  MOTM  OR  NEITHER  CELL  CONTAIN  A  FREE  SURFACE,  USE 

1725 

c 

DENSITY  OF  DONOR  CELL  To  OEFINt  MASS  FLUX. 

1  726 

c 

1  7  2 

.* 9  5 

IFIURR.gT.O.)  G  3  10  3  2 
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28  If  I  J .EQ. I  HA  X  I  GO  TO  SOO 

29  350  RHOT  •  RHOR 

30  GO  TO  370 

31  360  RHOT  ■  RHOtNT.M) 

32  VC-XMASSINT ,M)/RHOT 

33  C 

3  9  C  •••  ACCUMULATE  FLUX  ACROSS  R 1 6HT  BOUNDARY  • 

35  C 

3 6  370  SMMf»«RMOT»URR»fRACRT(Nr,M)*SDT»CYC 

37  »S«CYCMX/CTC»A3S I SMMP  I 

38  If  (  .VS.LT  .ROE PS»RHOT«VC  I  SHMP«0. 

39  SAMMP|NT,M)*SMHP  +  5>AMHPIHT,M> 

90  C 

<*J  C  •••  END  OF  LOOP  ON  MATERIALS 


92  C 

9  3  500 

99 

95 

96 

97 

98  C 

99  C 

50  C 

51  C 

52  C 

53  C 

59  C 

55  C 

56  C 

57  C 

58  C 

59  C 

60 
61 
62 
63 
69 

65 

66  C 

67  C 

6a  c 

69 

70 

71  1907 

72 

73  C 

79  C 

75 

78  C 

77 

78 

79 

8  1  C 

8  1 


CONTI NUE 

RETURN 

END 

SUBROUTINE  glue 
INCLUDE  COMOIM 

ADJUST  VELOCITIES  Of  CELLS  OVER-ACCELER ATED  BY  THE 
PRESSURE  EFFECTS  IN  PHI  BY  'GLUEING*  THEM  TO 
AM  APPROPRIATE  NEIGHBOP. 

GLUE  CELL  -K-  AND  CELL  -NK- 

•*«  two  passes  through  glue 

1  -  GLUE  ALL  CELLS  WITH  UNREAL  VELOCITIES  TO 

HIGHEST  PRESSURE  NEIGHBOR. 

2  -  GLUE  ALL  FREE  SURFACE  CELLS  TO 

highest  density  neighbor. 

DO  900  | G» I , 2 
DO  300  J* I  i  I  2 
DO  300  I « I  « 1  I 
K* 1 J-l ) • IMAX* I ♦ | 

JP*J 

IF1J.LE.UPR0J  .OR.  JPR0J.E«.0>  GO  TO  1909 

•  ••  Thf  FOLLOWING  REDEFINITION  OF  INp>EX  K  IS  NEEDED 

TO  GIVE  SYMMETRIC  TREATMENT  TO  UPPER  AND  LOWER 
HALVES  of  A  SPHERICAL  PACKAGE. 

JP= I2-J+JPR0J+1 
K» ( JP- I  > *  I  MAX  *  I ♦ I 
IF  I AMX IK > .LE.O.  I  GO  TO  300 
H"MFL AG ( K 1 

•  GLUE  CELLS  '.YirH  UNREAL  VELOCITIES  1MFLAG  NEGATIVE) 
OR  WITH  NEGATIVE  INTERNAL  ENERqY 

IFIM.LT. 0  . OR .  A  I  X ( X )  .LT  .0  .  ) GO  TO  100 

!F(  I  G • E  0 • I  .  OR  .  M.LT.IJOI  GO  To  300 
MM-M-100 

I F I RHO ( HVO I  0 , MM )  • L E • 0  •  )  GO  TO  300 


| no  NK  *0 


t  782 
1783 
178** 
1785 

17  8  4 
1787 
1783 

1789 

1790 
1  791 

1792 

1793 

1794 

1795 
1794 
1797 
l  793 
1799 
1  800 
180  1 
I  802 
1  803 

1804 

1805 
1804 
1807 
1803 
1  309 
1810 

18  11 
1312 
18  13 
18  14 
1815 
18  14 
18  17 
18  18 
18  19 
18  20 
182  1 
1822 

1823 

1824 
1  82S 
1824 
1827 
1823 
1329 
I  8  30 
163  1 
18  32 
183  3 

1834 

1835 


C  •••  DEPINE  K-INOEX  OP  NEIGHBOR  CELLS • 

KA«1 

<8»l  • 

KR»  I 
KL»1 

in jp.ne.jmaxi  ka»kmmax 
IFIJP.NE.1I  KB«K-IMAX 
IF  I  I  .NE.  l.HAx  )  KR-K+  1 
IFII.NE.il  KLaK-t 
IFIM.UT.O)  GO  TO  130 
IFUlUKl.LT.Q.lGO  TO  110 
c  ; 

C  •  ••  assure  that  f.s*  cells  a»e  glued  to  CELl  s  of  like 

c  material 

c  ;• 

C  i 

IF!  JP.EQ.  JMAX)  GO  TO  102 
M  A  a  MF  L  A  G  I  K  *  |  M  A  X  ) 

IF(MA,GT.  1001  GO  TO  101 
IF | XMASS ( MA.MMl .LE.O. >  KA»t 
GO  TO  102 
C 

lot  MAaMA-100 
XMaQ. 

00  1015  Nal.NMAT 

1015  XMaXM+XMASSfN,MM)»XMA55IN,MAI 
IFUM.GT.O.I  go  TO  102 

K  A  a  l 

c 

102  I F (  I  . E 3  .  IMAX  I  GO  TO  134 
MNaHFLAG ( K+ |  I 

IF  1  MR  .GT.  100)  GO  TO  103 
IF ( XMASSI MR ,MM) .LE«0. )  KR»1 
GO  TO  1 QH 
C 

103  MR=MR-100 

XMaQ, 

DO  1035  N  a |  ,HMAT 

1035  XMaXM*XMASS(N1M.M)oXMASS(M,MR) 

IFIAM.GT.Q. )  GO  TO  104 
KRa  l 

C  i 

104  1  F (  JP.EO.  1  I  GQ  TO  104 
MUaMFLAG I <- I MA  X ) 

IFIMB.GT. 100)  GO  TO  105 

IF  I XMASS ( MB ,  1m) .Lt.O.  I  K3al 
GO  TO  104 
C 

105  MO=M9-100  j 

X  M  a  o  . 

00  1055  4*1 ! N^aT 

1055  XM  =  XM  +  XMASS  1  4  ,  •1M  )  «  X^  ASS  (  M  ,  MB  1 

IFIXM.GT.O.I  GOTO  104  i 

Kfla  1 
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1934 

1037 

1830 

1039 

1090 

l  a  **  i 
1892 
1093 
1899 
1095 

1896 

1897 
1098 
1899 
1850 
1  SSI 
1852 
1053 

1859 
1855 
1  856 
1  857 

lass 

I  859 

1860 

1861 
1862 
1863 
1  969 
1065 
1866 
1867 
1869 

1869 

1870 
187  1 

1872 

1873 
1079 

1875 

1876 

1877 

1878 

1879 

1880 
1881 
1082 
1  983 
1  889 

1885 

1886 
1807 
1888 
1869 


C 

|06  1 F I  I ,E9. 11  50  TO  108 
ML»MFLAG(K-1  1 
tFCML.GT. 1001  GO  TO  107 
IF! XMASS < HL ,MM  1 .l£«0. *  KL»1 
GO  TO  103 
C 

107  KL»ML-100 
XM*Q, 

00  1075  N *  I  iNMAT 

1075  XM»XR*XMASS(N,MM>  •XMASS1N.11.) 

IF1XM.GT.0.)  GO  TO  10S 
K  L  *  I 

108  CONTINUE 
GO  ro  130 

c 

C  «••  GLUE  CELLS  AjTH  NEG,  INTERNAL  ENERGY  TO  NEIGHBOR 

C  OF  HIGHEST  RELATIVE  VELOCITY 

| 10  CONTINUE 
AS«0. 

IF < AMX 1 KA I .LE.O. J  GO  TO  115 

*S  «  IU1K 1-UIKA 1 1 »«2  ♦  | V t K ) -V  I KA I  ) *»2 

NXxKA 

115  1F1AMX1KR)  •LE.O. )  GO  TO  120 

ASA  «  lljlKI-UlKRI  >«*2  ♦  1V1K1-V1KR) )**2 
|F|j»SA.LT.AS1  GO  TO  120 
A  5  *  A  S  A 
NK«KR 

120  I  FI AMX ( k8 1 .LE.O. 1  GO  TO  125 

ASA  «  (U(Kl“U(XQl  I • • 2  *  1  V 1 K 1 “V 1  KB  I  1  •  *2 

IF1A5A.lT. A SI  GO  TO  125 

NK«KB 

125  IF< AMX (KL I .LE.O.  1  GO  TO  153 

ftSA  »  Ui(«l-UIKLM«*2  ♦  1 V 1 K 1 -V 1 KL 1  1  »*2 
IF1ASa.LT.AS1  GO  TO  150 
N  K  *  K  L 
GO  TO  ISO 
C 

C  GL'Jt  CELLS  >'J  1 T  H  UNREAL  VELOCITIES  TO  NEIGHBOR  *|TH 

C  HIGHEST  PRESSURE. 

C 

130  MFLAG(K)*1ABS(MFLAG(K1  I 

P  M  A  X  *  AMAX1  (  A0S(P<KA1  I  ,A8S(P(KRM  .ABSIPlKB)  )  .ABSlPIKL*  )  1 

c 

IFIABSIPIKAII.LT. PH AX)  GO  TO  135 
NKsKA 
GO  TO  150 

135  IF  1 A8S1P1KR)  1  .LT.PHAX )  GO  TO  190 
NK«*R 
GO  TO  150 

190  IF  1 ABSiPiKBll.LT .PHaX)  GO  TO  195 
nk  =  k  a 
GO  TO  150 
| 9S  NK=KL 
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1 


1  890 

C 

|89| 

ISO 

IFlNK.LE*  1  »  GO  TO  300 

1892 

ie < ABS | U(NK > » .LE.O.  .AND.  A  B  S 1 V ( NK  |  |  • L£ • 0  »  ■ AND • 

1893 

1  ABS  (  A  1  *  1 NK )  I  . LE • 0 .  1  GO  TO  300  1 

1  899 

C 

•  ••  COMPOTE  TOTAL  KINETIC  ENERGY  OF  THE  TAO  FELLS 

BEING 

1  89S 

c 

GL'JED  IK  AND  NKI.  ! 

1  89  A 

ftStaAHX(K)*(U(K)«a2+V(K)**2)+AMX(NK)* 

1897 

l  1  01  NK  1 • • 2 * V 1  OK  )  •  •?  1 

1899 

c 

Nev  MOLOCITIeS  to  conserve  MOMENTUM 

1899 

6SU«UHXtK)*U(K}*AMXINK  )»0(NK  ) ) / ( A M X ( K 1 ♦ A M X 1 NK  1) 

1900 

ASV*( AMX(K»*V(Kl«AMXtNK  )  •  V  S  NK  ) ) /  1  A M X < K ) ♦ A H X ( NK  )) 

1901 

c 

•••  NT.'.’  KINETIC  ENERGY 

1902 

WS2s(aMX(K)»AMX(.NK  l)«(aSU**2+ftSV*«2)  1 

1  903 

c 

GAIN  IN  KINETIC  ENERGY  (ALWAYS  NEGATIVE) 

19  0  9 

W3»(WS2--VS1  )/?. 

1  905 

ENEA  a  AMX(<)>AtX(K)  +  aMX(NK)»AIX(NKI  -  ;VS 

1906 

AIXtKI  *  ENe'V/(AMX(K)+AMX(NK1  1 

1907 

Al X  t  NK )  *  A  I X ( < ) 

1908 

c 

! 

1  909 

M»MFLAG(K) 

1910 

MFLAG1NK>=»IA0S(MFLAG(NK>  ) 

19  11 

MNaMFLAG 1 NK  1 

1912 

IF1M.LT. 1 00 ) GO  TO  1  197 

19  13 

M=M- 1 GQ  1 

19  19 

00  1  70  N 3 1  »  N M  A  T 

19  15 

IF  1  XMaSS 1 N ,M ) .LE.O. 1  GO  TO  170 

1916 

5  1  E  1  N  .  M  1  =  A  I  X  (  <  1 

19  17 

1  7U 

CONTINUE 

19  18 

1197 

IF1MN.LT* 100)50  TO  197 

1919  . 

M  N  =  M  N  -  l  0  0 

1920 

. 

DO  1 7G  N“ 1 iMMAT 

192  1 

1  F  1  XMaSS IN ,MN 1 .LE.O. 1  GO  TO  175 

1922 

S  I  E ( N , MN ) =A I  X ( NK  | 

1923 

1  7b 

CONTI NUE 

1929 

c 

***  NO  Tf  -  AFTER  GLUEING,  TmE  VELOCITY  COMPONENTS 

AND  THE 

1925 

c 

SPECIFIC  INTERNAL  energies  of  The  two  cells  are  equal 

1926 

197 

U  t  K ) * A SO 

1927 

U  (  NK  )  a.«SU 

1928 

VIKIavvSV 

1929 

V  (  n  K  1  a  *  s  V 

1930 

OKI  m  6, 900(11  l.Jp.K.NK 

1  931 

9000 

FORMAT  1216, 5HCELLS.  15. 5H  AN0.IS.7H  GLUED) 

1932 

300 

CONT 1 NUE 

1933 

900 

CON  T 1 NUE 

1939 

c 

1935 

RETURN 

1936 

END 

' 

19  37 

include  comdim  ; 

1938 

c 

1939 

c 

l 

1990 

c 

INITIALISE  BLANK  COMHO,!  storage 

199  1 

L  a  s  T  =  l 

1992 

10  =  0 

1993 

5 

I  a  =  I  Q  +  1 

38 


1999 

ZIIOI-O, 

19MS 

IF(LAST.GT.O)  <50  TO  5 

1986 

C 

1997 

CALL  INPUT 

1  998 

c 

•  ••  COMPUTE  TIME  STEP  AND  PRESSURES 

1999 

to 

CALL  COT 

1950 

c 

•  CHECK  ENERGY  CONSER V  A T 1  ON .  PR  I N T  ,  DUMP 

1951 

call  edit 

1952 

c 

*•«  wflasl  -  last  cycle  flag-  SET  JN  edit 

1953 

I r  < 6FLAGL.GT.0. )  CALL  EXIT 

1959 

c 

•**  WORE  PHASE 

19S5 

call  phi 

1954 

c 

•  «•  DEBUG  £  0  1  T  PRINT 

1957 

1 F  t  INTER.GT.O  .AND*  MPNINT.GT.OJ  CaLL  E01T 

1959 

c 

*••  DOES  CALCULATION  1NVL0VE  STRENGTH  EFFECTS 

195’ 

IFtCTCPH3.LT.CI*  I  GO  Til  20 

I960 

c 

•  •*  STRENGTH  PHASE 

1  96  1 

CALL  PH3 

1962 

c 

OEO'JG  EDIT  PRINT 

1963 

IF( INTER. GT.O  .AND.  N*»R  I  NT  .  GT  .0  )  CaLL  EDIT 

1969 

c 

•  •«  INTERFACE  NOTION,  MIXED  CELL  FLUXES 

1965 

20 

CALL  inface 

1966 

c 

•  »*  transport  phase 

1  967 

call  PH2 

1948 

c 

1  969 

GO  TO  10 

1970 

c 

197  1 

END 

1972 

SUBROUTINE  INFACE 

1  97  3 

c 

*••  COMPUTE  FRACTIONAL  AREAS  OF  MIXED  CELLS  TO 

GE 

1979 

c 

USED  IN  DEFINITION  OF  HASS  FLUX  TERMS. 

1975 

c 

•  ••  move  tkacer  particles. 

1976 

c 

•••  CREATE  NIXED  CELLS. 

1977 

c 

•••FLAG  cells  BECOMING  PURE  AMD  ADJUST  THEIR 

1  9  7  fl 

c 

FLUXES  To  FAACTLY  EVACUATE  1  HOSE  MATERIALS 

THAT 

1  979 

c 

ARE  leaving. 

1  980 

INCLUDE  COMO!** 

198  1 

EQUIVALENCE  (VfiY.RTr),  IWSa.TPXT,  (WSC.FRaCXI 

1982 

icr  *  inT(Cycmx) 

1983 

5Dr«DT/CYCMX 

1989 

c 

19  8  5 

c 

1986 

c 

•♦•  BEGIN  SUn CYCLE  LOOP 

1987 

c 

1988 

DO  875  L J  =  1 . I CY 

1989 

CYC«FLOAT (LJ)-l . 

1990 

c 

1991 

c 

1992 

c 

•••  COMPUTE  FRACTIONAL  AREAS  FROM  INTERCEPTS  M T M 

cell 

1993 

c 

BOUNDARIES  USING  UPDATFD  POSITIONS  OF  TR&CERS. 

1999 

c 

THFSC  A«r»s  ;«ILL  BE  IISfD  TO  COMPUTE  FLUXES 

UN 

THIS 

1  995 

c 

SUPCYCLE  OF  INFACE. 

1  996 

c 

1997 

c 

• • »  INITIALIZE  ARRAYS 

39 


1996 

t 

1999 

DO  29  N«1 . NVO  i  0 

2000 

DO  22  M«1 .NpXCLS 

200  I 

FRaCTP ( N iH 1  •  0» 

2002 

FKACKT(N>M»  =0. 

2003 

22 

CONTINUE 

2009 

29 

continue 

2005 

C 

•••  TRAVEL  AROUND  EACH  MATERIAL  PACKAGE  AND  USE  PAIRS  0F 

200  A 

c 

tracers  that  straddle  cell  boundary t S )  TO  COMPUTE 

2007 

c 

FRACTIONAL  AREAS. 

2006 

DO  36  N* 1 , NVO IP  j 

2009 

N  N  »  N  H  P  (  N  1 

201*0 

1FINN.EQ«0>(JO  TO  36  [  -  ■ 

201  1 

c 

2012 

c 

♦••STORE  THE  COORDINATES  OF  THE  FIRST  TRACER 

2013 

c 

OF  The  first  subpackage.  ' 

20  1  9 

TX3-  TXlN.lt  ; 

2015 

TT3»  TY IN, 1 ) 

20  1  6 

M  1  =  1 

2017 

M2=2 

2018 

c 

•••  start  loop  ON  M2 

2019 

200 

T  X  1  »  T  X  (  N  ,  M  1  1 

2020 

T Y 1 oTY l N  .M  1  ) 

202  1 

TX2=TX(N.N2| 

2022 

TT2bTY1N.M2) 

2023 

c 

2029 

c 

•••  1  T  X  3 , T  Y  3 1  IS  THE  FIRST  POINT  Op  THIS  PACKAGE 

2025 

c 

OR  SUBPACKAGE.  IF  TX  2bTx  3  AND  TY2»TY3, 

2026 

c 

the  package  has  been  completely  circumscribed* 

2027 

c 

2028 

IF  1 T X2  ,NE  .  T* 3  .OR.  TY2.NE.TY3)  GO  TO  211 

2029 

c 

•••  test  to  see  if  there  a«e  moke  subpackages. 

2030 

IF1M2.GE.NNI  GO  TO  36 

2031 

c 

•••  WILL  NEXT  TRACER  HE  EQUAL  TO  THE  FIRST  ONE 

2032 

1FITX1N.M2M  1  »  N  E  .  T  X  3  .OR.  T  Y  I  N  ,  m2  +  1  I  .  Nt: .  T  Y  3  )  GO  TO  39 

2033 

c 

...  preset  FRACTIONAL  AREAS  OF  CELL  K  HERE  IF  WE  ENTER 

2039 

c 

IT  FROM  aN  AXIS. 

2035 

211 

IFITXI.LE.O,  .AND.  TX2.GT.0.I  GO  TO  212 

2036 

IF  1 TY|  .LE.O.  .  a  N  p  .  TY2.GT.0.)  GO  TO  213 

2037 

GO  TO  2 | 5 

2038 

2  1  2 

J*  I N  T ( T  Y 1  ».l 

2039 

IF ( J.GT . I 2 1  GO  TO  2  IS 

2090 

M  X  A  X IS  =  Ml 

209  1 

K*  l  J-  1  l«  lMAx  +  2 

2092 

M»IABS(MFI AG(K> ) 

2093 

iriH.GT.10U)  GO  TO  2120  , 

2099 

MO  =  M 

2095 

1  =  1 

2096 

CALL  NEA'IlX 

2097 

2  120 

M  ■  H  -  ]  u  0 

2098 

F  K  A  C  T  P  (  N  ,  11 )  =  T  A  U  1  1  1 

2099 

FRACKT  (  N  .H  1  =fJY  1  .M  »X  [  J  )  •T..UPI 

2050 

IF  l  t  GH.tO.  1  )  F  P/tCKT  l  N  .M  )  «DY  1  J) 

205  1 

MB= I ApS l MFLAG 1 K- I NAX 1 )- 1 00 

40 


2052 

IFCMB.LT.O  .OP.  J.EO.l)  GO  TO  215 

2053 

FR*CTH(n.HB)»TAU1 1 1 

2059 

GO  TO  2 1 5 

2055 

213 

1«  I  NT  I TX 1 1*1 

2056 

2Flt.GT.lll  GO  TO  2 1 S 

2057 

M  Y  A  X  1  S  ■  M  1 

2058 

K*l*l 

2059 

H» 1 AU5 ( HFlAG  1  K  )  > 

2060 

inn.Gf.lfUJ)  (;0  TO  2130 

206  1 

M  0  m  n 

2062 

J“  t 

2063 

CALL  N  £  ft  M  I X 

2  0  6  9 

2130 

M  ■  (1  “  1  0  0 

2065 

ML= 1 AH5 ( MELAG ( K- 1 » 1-100 

2066 

IF (ML.LT  *0«  .hr.  I ♦ CQ  *  1  1  GO  TO  219 

2067 

FHACRT(N.ML)=oTn  )**f  t-l  »  *  T  W  0  P  I 

2069 

IF ( IGM.EQ. 1  1F0ACRT  (  N  » M  L  I  ■  0  Y  t 1 1 

20  6  9 

2  1  9 

FR«CTP|*|,!11sT*UU) 

2070 

FRaCRTIN.M>*DY(I)»X11  1  •T'.VOP  1 

207  l 

tF(IGI1.C'Y.HFRACHTlN,M)»DY(n 

2072 

215 

CONTI  HUE 

2073 

C 

•••♦IF  BOTH  POINTS  ARE  ON  THE  SamE  AXIS,  SKIP  OUT 

2079 

1F1TY1+TY2.LE.0. )G0  TO  33 

2075 

|F(TX)*tX2  • LE  *  0.)  GO  TO  33 

2076 

c 

2077 

ITXt  »  INTITXII 

2078 

1  T  Y  1  *  I  N  T  1  T  Y  1  ) 

20  79 

ITX2  »  INTITX2) 

2080 

I  T  Y  2  *  1  N  T  1  T  Y  7.  > 

2081 

ITXBMTXl 

2082 

I TYB-1 TY  l 

2033 

c 

•••  IF  BOTH  POINTS  ARE  OUTSinE  THE  ACTIVE  GRID.  SKIP  OuT. 

2089 

IF  I  1TX1  .GT.F1.0ATI  1  1  1  .OR.TYI.GT.FLOaTI  12H  .  A ND . <  T X 2 . GT . F  LO A T  < I  J  , 

2085 

1  .OR. TY2.GT. FLOAT! 12))  I  GO  TO  33 

2086 

c 

•  ••  IF  BOTH  POINTS  ARE  IN  THE  SAME  CELL,  SKIP  OUT. 

2087 

23 

IF  (  I  TX  1  .Eg. I T <2  .AND.  I  T Y  I  .  EQ . 1 T Y 2 )  GO  TO  33 

2088 

1  »  I  T  X  1 

2089 

IF11TXI.LT.ITX2)  I » I ♦ 1 

2090 

J= I TY  1 

2091 

lKlJTri.LT*!  T  Y  ?  1  J  =  J+1 

2092 

RTX=FLOAT (I) 

2093 

TPY  =  FLOA  T 1  J ) 

2099 

c 

...  !>■  CELL  DIMENSIONS  ARE  CONSTANT,  CAN  USE  CELL  UNITS  T0 

2095 

c 

COOPUTE  SLOPE  -  OTHER ft I5E>  MUST  CONVERT  TRACER 

2096 

c 

COORDINATES  TO  CM,  UNITS. 

2097 

IF!  JVARDX.EO.O  .AND.  IVAR0Y.EQ.il)  GO  TO  231 

2098 

c 

♦•*  CONFUTE  CM.  VALUES  OF  COORDINATES 

2099 

XC9|*  X(ITXM)  .  1 TX 1-A INTI  1X1)  ) *0X 1 I TXB+1  > 

2  100 

XCM2  =  X  1  ITX2I-M  T X 2- A  I  NT  1 T X 2 >  I«OXI  ITX2M  ) 

2101 

V  C  N  1  =  V  (  l  T  (l\  )  *  1  T  Y  |  -  A  I  N  T  1  T  Y  ]  )  )  •  0  Y  (  |  T  Y  ij  ♦  I  ) 

2  102 

yC:12*Y(ITy2IhTv2“AIHT1TY2»  1  •  0  Y  1  I  T  T  2  *  1  • 

2103 

c 

...  c OMIMTE  SLOPE  OF  LINE  THROUGH  THESE  TWO  POINTS 

2109 

SLOPE* 1 YC12-YC91  1 /  1  <CM2-XCM1  l 

2)05 

r 

...  COM-’OTE  INTERSECTIONS  'VjTH  CELL  BOUNDARIES 

41 


04 

RTT«YCM2*St0PF»( X (  t  )  -XCM2  > 

07 

TPX*XcM2*(Y(J)  -VCI92  1  /SLOPE 

08 

1  T*  1 

09 

JT»  J 

10 

c 

•••  CONVERT  INTERSECTIONS  to  cell  units 

1  1 

IK  II  Ty  1  .EJ.  1  Ty2I  'SO  to  235 

12 

DO  239  I 3 1  ,  11 

13 

IFITPX-Xdll  2  3  2.233.739 

19 

232 

TPX  =  rLOATM-l  I-ITPX-X  1  I-!  )  >/IX(  I  )“X(  1-1  )  ) 

IS 

GO  TO  235 

1  4 

233 

TPXaFLOAT I  I  1 

1  7 

GO  TO  235  ! 

18 

239 

CONTINUE 

19 

NK * 2  3  4 

20 

N  R  *  9 

21 

CALL  ERROR 

22 

215 

continue 

23 

c 

29 

IP! 1 TX1 ,£Q» t TX2)  GO  TO  239 

2S 

DO  238  J»1 , 1 2 

26 

IFIRTY-Y(Jl)  234,237,238 

27 

236 

RTY*FLOAT<J-!l*(RTY-y(J-ll>/mj)-ytJ-l>) 

28 

GO  TO  239 

29 

237 

RTY=FLOAT(J) 

30 

GO  TO  239 

3  1 

238 

CONt INUE 

32 

NK  a  2  3  8 

33 

NR  =  9 

39 

PRINT  7777  ,  «TY  ,Y t J)  ,Yl 12) »SLOPE .YcMl  .TCM2.TY1  ,TY2 

35 

777  7 

FORMAT  (1H1.8E16.8) 

36 

call  ERROR  1 

37 

239 

CONTINUE 

38 

1  *  l  T 

39 

J«  JT 

90 

GO  TO  2390 

9  1 

c 

92 

231 

SLOPEa(TY2-TYD/(TX2-rXl  I 

93 

RTY=Tr2+SL0PE*(RTX-TX7) 

99 

tp x=t X2* ( TPY- rY2 i /slope 

9  S 

2390 

FRACYaO. 

96 

F  R  A  C  X  *  0  . 

97 

1  F  (  I  T  Y  1  .  EQ  •  IT  Y  2  1  GO  TO  242 

98 

I F (  I T  X 1  , EQ •  1 T  X  2  >  GO  TO  28 

99 

c 

•••  IF  POINTS  STRADDLE  BOTH  A  TOP  ANO  A  RIGHT 

CELL 

50 

c 

BOUNDARY,  PROCESS  FIRST  THE  ONE  CLOSEST  To 

the 

51 

c 

TRACER  ( T  X 1  , T  Y  t  1. 

52 

DRT  =  SQRT(  (RTX-TX1 1 • *  2  ♦  (RTY-TYl )».2) 

53 

0TP  =  SqRT (  (  TPX-TX 1  1 *»2  ♦  1  TPY-TY 1  1 »»2 ) 

59 

1  F  (  ORT  ,  G  r  •  OT  P  )  GO  To  28 

55 

c 

56 

292 

FRACYaSTY-AINT(RTY) 

57 

J'INT(RTY)  i 

58 

IKIFRACY.GT.O.  1  J»J*1 

S’ 

IF  (FBaCy.LE.O.  .AND.  1TXI.LT.ITX2)  J=*JM 

FIRST 


42 


2160 

IF( t.LE.O  <08,  J.LE.O  .OR.  I.GT.IM*X  .OR.  J.GT.JMaXI  GO  TO  33 

214  1 

K*lj"l  ) » 1  MAX ♦ 1  *  1 

2162 

M*IABSIMFlAGI<>  > 

2163 

MB*lA8S<MFLAGt«-IMAX|)- 100 

2161 

HL«IAB5<NFLaG1K-1  >  >-100 

2145 

KR«K+1 

2)66 

MBR*IA8S1MFLAG<KR-IMAX)  1-100 

2167 

C 

IF  CELL  ON  LEFT  OF  POINT  PREVIOUSLY  A  PURE  CELL. 

2168 

C 

CALL  NEA  MM  TO  SET  UP  STORAGE  FOR  IT  IN  M  t  XEO  CELL  . 

2  169 

C 

ARRAYS,  and  COMPUTE  FLUX  FOR  SUBCYCLES  COMPLETED* 

2170 

IF1M.GT.100)  GO  TO  290 

2171 

MO*  M 

2  172 

CALL  NEY/MIX 

2173 

C 

•••  if  material  n  just  entered  cell  on  left  of  point. 

2179 

C 

CALL  NEYRHO  TO  ASSIGN  A  DENSITY  TO  IT. 

2  1  7  S 

290 

M*M-!00 

2  176 

IF1RH01 N.M) .u:<0.  .AND,  N.NE.NVOID)  CALL  NE*RhO 

2177 

IFIN.EU.NVOID*  R  -iO<NV<MD.M)*I  .0 

2  17S 

IF(l.GE.IMAX)  GO  TO  25 

2179 

mrmarsimflagkrm 

2  180 

C 

**♦  rr  cell  on  right  of  point  was  previously  a  pure  cell. 

2  18  1 

C 

call  NEJMIX  to  set  UP  STORAGE  FOR  IT  IN  MlxEO  CEEL 

2182 

C 

ARRAYS,  and  compute  FLUX  for  SubCYCLF.S  COMPLETED. 

2183 

IFI MR .GT. 1001  GO  TO  29  1 

2189 

MO*MR 

2  185 

mt«m 

2  186 

I  T  *  1 

2187 

aT*k 

2188 

K  *  X  R 

2  |  89 

1  =  1*1 

2  190 

call  NEWMJX 

2191 

MR  a  M 

2  192 

f  -  t  r 

2193 

K  =  K  T 

2199 

M»MT 

2195 

C 

•  ««  J  F  MATERIAL  N  just  ENTERED  CELL  ON  RIGHT  OF  POJNT, 

2196 

c 

ASSIGN  To  IT  THE  SAME  DENSITY  AS  THAT  ASSIGNED  TO 

2  1  97 

c 

CELL  OH  LEFT. 

2198 

29  1 

MKaMR-lbn 

2199 

lFlRHO(N.MR).LC.Oi)  RHOCN,MH)«RHO(N,M) 

2200 

c 

•*«  COMPUTE  FRACTIONAL  area  for  radial  TRANSPORT  of 

2201 

c 

MATERIAL  n. 

2202 

25 

IFl  ITX1  .LT. |  TX2I  go  TO  26 

2203 

c 

...  ENTERING  cell  k  -  leaving  cell  kr 

220  9 

lilS  a  (STY-FLOaTI J“) ) 1»DY( Jl*xl I )*TWOHI 

2205 

IFUGM.EN.  1  )'»s=  I  HT  Y-ELOAT  (  J-  1  )  )  «0Y  1  J> 

22  0  6 

c 

...  P.irsET  FRACTIONAL  AREAS  OF  CELL  K  YIHICH  v.E  are  entering 

2207 

IV  S  A  3  D  Y  (  J  )  •  X  I  1  1  *  T  0  p  I 

2208 

IF  1  igm.eg . n J  S  A  °  0  Y t  J) 

2209 

IF  (FRACRT  (N.M)  .LT.HSA  .  AND.  FRACHTiN.MI+WS  .GT.  A'SA)  go  TO  253 

2210 

1E1MM.lT.:)  J.LG.I)  Gil  10  251 

221  1 

1  F  (  ERACTP  I  N,  MR  1  .  GT  •  0  .  .AND.  F  R  AC  TP  (  N  .  Mji  )  .  L  T  .  T  A  U  (  I  )  )  GO  TO  255 

22  12 

FRACTP IN. Mb)  a  T  A  0 1  I  1 

2213 

251 

IMML.LT.D  .T>.  1  •  CO  .11  GO  TO  252 

43 


22  19 
2215 
22  I  A 
22  17 
2218 

2219 

2220 
222  1 
2222 
2223 
2279 
2225 
222b 

2227 

2228 

2229 

2230 
2  231 
7232 
2233 
2239 

2235 

2236 

2237 
2230 
2239 
2290 
229  1 

2292 

2293 
2299 
2295 
22  96 

2297 

2298 

2299 
2250 
225  I 

2252 

2253 
2259 
2255 
225  A 

2257 

2258 

2259 
2  2  40 
224  1 
2242 
2?t>3 
22ft  9 
2245 
2244 
2  2  4  7 


W  S  A  »  D  Y  1  J  I  *  X  <  I  - 1  1  •  TttOt*  t 
|F|  IGM.EQ.  I  >-f5A»0Y<  JJ 

IF  I  F  R  A  C  R  T  (  M  ,  M  I.  )  «0T  •  0  ,  .aNO.  FR  A  CR  T  I  N  .  ML  1  •  L  T  .  W  S  A  )  GO  TO  255 
fKACHT  (  N  .  01.  (  «  w  5  A 

252  1 F ( FRACTP < N,M> . fa T , 0 .  .ANO.  FR ACTP 1 N , M > .L T . T *U | !)J  Go  TO  255 
FKACTPI  N  ,  II  I  =  T  A  *  I  (  I  1 
2S5  «5a  a  GY  <  J  I  ♦,<  (  11  »T:»Or  1 

i f  1 1  gm.eQ.  1 1  rsa«oy  ( ji  ; 

c  •••  9 e 5 t t  fractional  areas  of  ct'LL  kr  which  we  are  leaving 

if  (FRACRT  ;H,0  I  ,<nT  .n.  .and.  FRACRT(n.H)+KS  .LT.WSA)  GO  To  254 
753  IF (WS.GE*  V5A.0R. 1  .EO.  t«AX  1G0  TO  254 

ififractpin.npj .oT.o.  .and.  fractp i n , Mft ) .lT .Tad i i  +  i  i  j  go  to  256 

FRACTPtN,i9R)'<»0. 

k.SA  a  DY  1  J)  »'AI  I  +1  1  »T»’0P1 

IFliGM.EQ.il  *'5A«0Y  (  J  | 

IF  (  FRACRT  IN, MR  1  .GT.O.  .AND.  FR  ACRT  (  N  .  MR  1  .  LT  ,  *S  A  1  60  TO  254 
FRaCRT ( H  »  MR )  a  0* 

IF  1MUR.LT.13  .OR,  J . £ 0 .  1  )  GO  TO  254 

I  F  <  FR  ACTP  l  N  , ’1f>p  )  .  Gl  .0  .  .AND.  F R A C T P 1 N , MRR ) . L T , T a U < I + 1 ) >  GO  TO  25* 

fRactpin.iihri  =  C. 

756  I  T  X | ® I T  X 1  -  1 
GO  TO  275 

C  •••  tNTLRING  CELL  KR  -  LEAVING  CELL  K 

26  W S  «  ( FLOAT ( J 1 -RTY I »0Y < J 1 «X l I  1 «TWOP I 
IF  1 J  GM.EQ. I  ) *5= (FLOAT ( J 1 -RT Y ) «0Y  <  J) 

C  PRFSET  FRACTIONAL  AREAS  OF  CELL  KR 

IFlI.GE.IMAX)  GO  TO  765 
ws  a*OY  (  J  I  «  X  II  )  »TV.OP  1 
IFlJGM.EO.il  VISA-IVY  <  J  1 

I F ( FRACRT (N ,M) .LT.wsa  .and.  FRACRT ( M ,M) +ws  ,GT.  WSA1  GO  TO  263 
IF ( FRACTP ( N , Mu ) , GT »0.  .AND.  FR A C TP < N , MR ) . L T . T *0 ( I ♦ 1 ) }  GO  TO  265 
,F  R  A  C  T  P  l  N  i  MR  1  *  TAUtj+1) 

*  .  S  A  =  0  Y  (  J  )  •  X  (  f  ♦  1  I  *  T  V>  0  P  I 
IF  (  iGfl.EQ.  1  )  W  S  A  =  D  Y  1  J  ) 

I  F  (  FRACR  I  (  N  ,i|B  j  .  GT*0  .  .AND.  FRACRT  (  N  ,  M  K  )  .  L  T  •  A  S  A  )  60  TO  265 
F  R  A  C  R  I  1  N  .  M  R  )  =  v'.  5  A 

IFIiiBR.lT.O  .nr<.  J .  r  Q .  1  )  60  TO  265 

IF  IF0ACTP  1  N, 'IRK)  .gT.0.  .AND.  F  R  A  C  T  F  (  N  ,  HR  R  J  .  L  T  .  T  A  0  I  I  ♦  1  )  >  GO  TO  265 
FRACTP IN.9HR)  =  TAU(l+l) 

C  •••  RESET  FRACTIONAL  A«EAS  OF  CELL  k:WhICH  WE  A«E  LEAVjNG 

24  5  AS  *  =  OY  (  J  I  a  X  <  I  1  *T'iOIM 

1  F  I  16i'.  fj  .  1  1  .;*-,A  =  DY  <  j  1 

I  F  1  F  R  ACR  T  ( .1  ,  II I  .  at  .  o  .  .AND.  FRACRT  (N.MI+IMS  ,LT,  «SA)  GO  TO  27 
IF ( |NT ( TX (N.MYAX IS ) ) +  1 .EQ. I . ANO.  J.EQ.  I  )  GO  TO  27 
2  6  3  1  F  t  rill  .  L T  •  i)  .  ') b  •  J  .  L •)  •  1  )  GO  TO  2  6  4  1 

IF  (  FRACTPI  N.MP.  1  ,GT  .0.  «ANf>.  F  R  AC  T  P  l  N  ,  Mb  )  .  L  T  .  T  AU  1  1)  )  GO  TO  27 
FRaCTPIN.M’M  a  0. 

2  46  «5a  =  0Y(J)«X'1-I)»  T  “iOP  I 
I F |  16H. EQ.  1  )NSA  =  UY ( jl 

IF  <  1  NT  l  T  Y  IN  ,MX  A  A  ;  S  1  1  ♦  l  .K').  J.  AND,  I  .eQ.  1  I  60  To  27 
IF  1  f-i  L  .  I-  r  .  *3  .Of.  T  .  t.  <J  .  1  I  GO  TO  267 

IF  (FMACRTlN.Nl.  )  .61.0.  .Alii).  FRACRTIN.MLI.LT.KSA1  60  To  27 
FR,>CR  T  (  N  ,  ML  )  »  0  . 

l'-lff  ACTiMN.Ml  ..  1 1 T  ...NO,  rflcrPlu.MI  .LT.TA01  I  1  I  60  TO  27 
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226* 

FRACTP<N,MI*0. 

2»69 

27 

irxi«iTxt*i 

2270 

C 

•••  UPDATE  FRACKTIN.M) 

227  1 

275 

FRACRTIN.M)  *  FRACRT (N,M)*AS 

2272 

WSA  •  DV  (  J)  »X  (  1  1  MIVOP! 

2272 

I  f  (  1GM.E0.  1  »NSA*I)Y<  J) 

227  4 

IP  (  FRACRT  t  N  ,M  >  .GT.Nsa  1  FRACRT<N,M)bFRACRT<N,M)-WSA 

227* 

C 

»»•  A  FT  E  9  INCREMENTING  JTX1,  GO  BACK  TO  23  To  SEE  IF 

2276 

C 

mope  cell  boundaries  betwf.en  these  two  tracers 

2277 

c 

NEEO  TO  be  PROCESSED. 

22  7* 

GO  TO  23 

2279 

c 

2280 

c 

•••  IF  THESE  T*<0  PTS  STRADDLE  A  TOP  BOUNDARY, 

2  2  B  1 

c 

FINN  INTERCEPT  and  CALCULATE  A  FRACTIONAL  AREA  IFRaCTp) 

2292 

c 

2233 

23 

FRACXbTPX-AJNT(TPX) 

2284 

I  ■  1  N  T  1  T  P  X  I 

2285 

IF1FRACX.GT.3. )  1*1*1 

2286 

IF1FRACX.LE.0.  .A  NO,  ITT1.GT.ITY2)  1*1*1 

2287 

1FII.LE.0  .OR,  J.LE.o  .OR.  I.GT.IHaX  .OR.  J.GT.jMaX)  GO  TO  33 

2288 

K* I J-l  ) • I  MAX* ! *1 

2239 

M*  1  ABS  t  MFLAf,  (  K  1  ) 

2290 

MB* I  AOS < Mr  LAG ( K- 1  MAX )) -  1 00 

2291 

ML* I A8S( MFLaGIKtI 1 )-l 30 

22  92 

KA*K*[MaX 

2293 

MLA*IA8S( MFLAgIKA-I n-100 

2294 

c 

IF  CELL  BELOW  POINT  WAS  PREVIOUSLY  A  PURE  CELL. 

2295 

c 

CALL  NE<1M|X  to  SET  UP  STORAGE  FOR  IT  IN  MIXED  CELL 

2294 

c 

ARRAYS,  aNO  COMPUTE  FLUX  FOR  SUBCYCLES  COMPLETED. 

2297 

1FIM.GT, 1 30 1  GO  TO  280 

2293 

MO»M 

2299 

call  mew  mix 

2300 

c 

«•«  IF  MATERIAL  n  JUST  ENTERED  CELL  BELOW  POINT, 

230  1 

c 

CALL  NEWRHO  TO  ASSIGN  A  0EN5ITT  TO  IT* 

2302 

280 

M«i-ino 

2303 

IFIRHOIN.M) .LE.3.  .ANO.  N.NE.NVOID)  CALL  NEWRhO 

2304 

IFIN.E9.NV/01D)  RMOI  NVOIO  .M)  »l  .0 

2  3  05 

1 F ( J.GE . JMAX I  GO  TO  29 

2306 

MA*  I  ABS ( MFLaG ( < A )  I 

2307 

c 

...  ir  CELL  ABOVE  POINT  WAS  PREVIOUSLY  A  PURE  CELL. 

2108 

c 

CALL  NE'Amjx  TO  SET  UP'StORAGE  FOR  IT  IN  MIXED  CELL 

2309 

c 

A R 9  A T 5 ,  AND  COMPUTE  FLUX  FOR  SUBCYCLES  COMPLETED. 

23  10 

IFIMA.GT.lOO)  GO  TO  291 

231  l 

M  0  *  M  A 

2312 

MT=M 

23  13 

jTa  J 

2314 

KTaK 

23  15 

K*KA 

23  1  6 

J*J*l 

23  l  7 

CALL  HE. MIX 

2319 

M  A  *  M 

23  19 

M  =  MT 

2  320 

k*xt 

2  12  1 

J*  JT 
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1 


2322 

2323 
23  2*4 

2325 

2326 
2322 
2  3  2  S 
2  3  2  2 
23  30 
233  ! 

2332 

2333 
233*4 
2  3  3*3 
23  36 
2337 
23  37 
2337 
23-40 
23  4  1 
23*42 
23  4  3 
2  3 '4  6 
2  3  *4S 
2346 
23*47 
23-43 
23*49 
2  3*30 

235  1 

2352 

2353 
235*4 

2355 

2356 

2357 
23ft« 

2359 

2360 

236  1 
2.362 
2363 
236*4 

2365 

2366 

2367 
2369 
2  3  o  9 
2  370 

2371 

2372 

237  3 
2  3  7  -I 
2  3  75 


C  •••  IF  MATERIAL  N  JUST  ENTERED  CELL  ABOVE  POtNTt 

C  ASSIGN  To  IT  THE  SAME  DENSITY  AS  THAT  ASSIGNED  TO 

C  CELL  BELOW . 

781  MA»MA-100 

|F(«H')lN.*44).Li:.O.I  RmOIN  ,  MA  »  «RHO(N  ,M  ) 

C  IS  MATERIAL  ON  RIGHT  OR  LEFT  OF  INTERCEPT 

29  l«SX*!NT t TPX l 

WSX»X  U  .USX  1  *■  OX  (  I3SX+  1)  »FRACX 
IF  t  t TY 1 ,LT  t  1  TY21  GO  TO  295 

C  ENTERING  cell  k  -  leaving  cell  ka, 

W  S  o ( x  1  I ) • • 2  -  HSX«»2I«P|0Y 
I  E  (  IGM.E3.  I  |  -V  5  ■*  X  <  I  l-.YSX 

c  •••  PRESET  fractional  AREAS  OF  CELL  K!*H!CH  WE  ARE  ENTERING 

IF  I  FRaCTP ( N,M  )  .LT  .  TAU (I)  .ANO,  F R A C T P t N , M ) ♦ WS  . G T  .  T AU  (  I  I  ) GO  To  293 
ASAaQY  (  J)  M  (  I  )  «T(VO,JI 
IF  1  I GM.EN . 1  »  TSA  =  DY ( J I 

IF  (  FR  ACRT  (  N  ,.1)  .r,T  .0.  4  A  N  0  4  E  R  A  C  R  T  f  N  ,  M  )  ,  L  T  4  WS  A  )  60  To  293 
FR  ACRT  1  N  » *1 1  *65  A  ) 

If (KB4LT.0  .OR.  J  4  E  0  4 1  1  GO  TO  292 

IFIFRACTPIN.MBI  ..JT.0«  .AND.  F  R  A  C  T  P  (  N  ,  MB  )  4  L  T  4  T  A  U  (  1  )  )  GO  TO  293 
FR AC  TP ( N  ,  Mil  )  a  TA  J (  I  I 

292  IFIML.LT.O.  .OR.  I  t  EO  <  1  )  GO  TO  293 

W  S  A  *  0  Y I J) »x (  I  -  1  ) »T  TOP  I  j 

IF  (  I  G  N  4  E  0  4  1  )  .V  S  A  =  0  Y  <  J  ) 

IF IFRSCRT (N,ML» .GT.O.  .AND.  FR A C R T ( N , ML ) . L T . WS A  1  GO  TO  293 
F«ACRT  (  N  ,  ML  )  *'*'5  A 

C  RESET  FRACTIONAL  AREAS  OF  CELL  KA  WHICH  ivE  ARe  LEAVING 

293  I  F  (  FRACTP  (  N  ,M>  ,GT  .0.  .AND.  FR  A  C  T  P  [  N  ,  M  )  ♦  WS  ,LT'.  TAUII))  GO  TO  299 
IF ( J.EO. JMAX1G0  TO  299 

I F (  I  NT ( T  T  t  N  ,  NX A  x  I  3 )  1 >EQ  #  J • AND  4 l 4  El . 1 )  GO  TO  299 
IF<MLA.|_T.O  .  OR.  l.ER.ll  GO  TO  29*4 
.VSA«OY  1  J+ 1  I  «X  (  I- |  I  •  T  TOP  I 
IF ( IGM.E3. 1 ) WSAsOY IJ* I ) 

IF  1 FRACRT  I  N ,MLA )  .G r.O.  4  A  NO  4  F R A C R T 1 N , ML  A > . L T  .  W S A  I  GO  TO  299 
FKACR H N |MLA ) =0. 

2  9  *4  IF(FRACTP(N,MA)  .GT.rj.  .  A  NO  4  F  R  A  C  TP  (  N  ,  H  A  )  .  L  T  .  T  A  U  I  I  )  )  GO  TO  299 
F«ACTP<N».MAt»04 
2941  VSA  =  OY ( J* 1  ) .X {  I  1 « T  TOP  I 
I  F  I  I  G  M  •  E  N  4  I  )  ■/  S  A  *  0  Y  (  J  ♦  1  I 

I  F ( FRAC R T ( N  ,  M A  I  .  G r  •  0  .  .AND.  FR ACRT i N »MA I .LT  .WS A >  GO  TO  299 
FRACRT  (  N  ,  .4  A  J  =0  . 

;i9  |Tyi»itym 
GO  TO  31 

C  ENTERING  CELL.  Krt  -  LEAVING  CELL  K  j 

295  AS  =  CAS  X  4  «  2  -  X  (  1  -  1  )  •  »2  )  »P  I  OY 

if<  igm.eo.  nos=.*isx-xi  1-1 1 

C  PRfSFT  FRACTIONAL  areas  OF  CELL  KA 

I  r  (  j .  g E  •  jma  x )  <.n  ro  297 

I  F  (  FRACTP  (  N  ,  M  )  .  1.T  .  TAU  (  I  I  .AND.  F  R  Ac  T  P  (  N  ,  M  I  ♦  WS  ;  .  G  T  .  T  4  U  (  I  >  )  GO  To  297 
IFIMLA.lT.O  .or,  1  .  f  N .  1  |  GO  TO  796 
.7  5  A  ■  0  T  <  j  ♦  1  )  *  X  (  1-1  )  *  T  -<  0  P  I 
1  f  (  1  Or- .  EN«  1  1  ■7SA  =  D  Y  (  j*  1  1 

IF  if  WACFiT  in  ,-iu  ) -G-T  .0.  .AND.  FK  AC  RT  (  N  ,  ML  A  )  .  L  T  .;WS  A  >  GO  TO  297 

r  R  ACRT  1  :i  ,i-l|.  f  I  =  vs  •> 
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2376 

296 

)  .CiT.O.  .AND.  F  R  AC  T  P  I  N  ,  M  A  )  .  LT  ,  T  AU  (  I  )  )  GO  TO  297 

2377 

FRACTP(N»MA)«TAU( 1 1 

2378 

WSA«DY( j*l )*XI  1  )*TW0PI 

2379 

JF(  IGI1.E0.  n  3  5  A  B  D  Y  IJ*  1  ) 

2380 

IF (FRACRT ( N ,HA > .GT.O.  .AND*  FR ACR T ( N t MA ) . L T . WS A )  GO  TO  297 

2  3  B  I 

FRACHT(N.HA)  *  ASA 

2382 

C 

RESET  FRACTIONAL  AREAS  OF  CELL  K  WHICH  WE  A«E  LEAVING 

2383 

297 

IF  1  FRACTP  (  N  ,H  )  .GT  .0.  .AND.  F R  AC  T P  (  N  ,  H  )  WS  ,LT  •  TAU(U)  GO  TO 

30 

2389 

IF(WS.GE*TAU( I ) 1  GO  TO  30 

2  3  65 

*VSA«DY  (  J  )  *  X  (  I  i  ‘Tf/OP  t 

238  4 

I  F  (  IGll.EO-  1  )  IV  5  A  •>  D  Y  1  J  ) 

2387 

|F(FRaCRTIM,H).GT«0.  .and.  FRACRTCN.M) .LT.WSA)  go  TO  30 

2388 

F  R  A  c  R  T  <  N  i  M  >  »■  0  . 

2389 

I  F l I  NT ( TX I M ,MY AX  1 5 ) ) +  1 .EQ . I • AND. J.tQ. I »  GO  TO  30 

2390 

IFtMB.LT.O  ,0P.  J.ECJ.I)  GO  TO  29R 

2391 

IFIFRaCTPIN.MR) .GT.O.  .and.  FRACTPINlMDl .LT.TaU(I) 1  GO  TO  30 

2392 

FRACTPfN.MB)  =  0. 

2393 

298 

IFtML.LT'O  .OR.  I.EQ.l)  GO  TO  30 

2399 

ASA  =  OY(J)»X(I-n*TftOPl 

2395 

1FI  I  G  M  .  E  Q  .  1  )  W  5  A  *=  0  Y  <  J  ) 

2398 

tFCFRACRT(N,ML> *«T.D.  .and.  F R AC R T ( N  .  ML > • L T . W S A  1  GO  TO  30 

2397 

FRACRT 1 N  »ML)=0 • 

2398 

30 

ITYl*ITYUi 

2399 

C 

•••  UPDATE  FRACTPIN.MI 

2900 

3  1 

F  R  AC  TP  (  M  .M  1  sf  RAC  TP  t  H  ,N)*W5 

2801 

IF.IFRA. CTP(N.N)  .GT.TaUI  I)  )FRACTP(N,M)*FRACTPIN,M)“TAIM  I  I 

2902 

32 

CONT INUE 

2903 

C 

•  ••  AFTER  INCREMENTING  I T Y I  ,  GO  BACK  TO  23  TO  SEE  IF 

2909 

C 

MORE  CELL  BOUNDARIES  BETWEEN  THESE  TWO  TRACERS 

2905 

C 

NEED  TO  PE  PROCESSED. 

2  9C6 

GO  TO  23 

2907 

c 

COME  HERE  WHEN  ALL  BOUNDARIES  BETWEEN  TWO  POINTS  HaVE 

2908 

c 

been  processed  or  WHEN  TWO  POINTS  ARE  IN  THE  SAME 

CEL,  . 

2909 

33 

CONTINUE 

29  1  0 

c 

RESET  FRACTIONAL  AREAS  OF  CELL  K  HERE  tE  WE  LEAVE 

IT 

29  I  1 

c 

OF'  AN  AXIS. 

29)2 

1FITX2.LE.0.  .AND.  TX2.LT.TX1I  GO  TO  392 

2913 

IHTY2.LE.0,  .AND.  TY2.LT.TY1)  60  TO  399 

29  1  9 

GO  TO  35 

29  15 

382 

J* 1  NT ( TY2 ) ♦} 

29  1  6 

IF ( J.EG. INT ( TY3 ) + 1 )  GO  TO  35 

29  17 

IFI  J.GT. IZ)  GO  TO  3  5 

2918 

K“ I J  -  1  1  • I M A  X*  2 

29  19 

M= I AFS  <  HFLAGI F  )  ) -1 CC 

2920 

IFIFRACTPIN.N) .LT.TAUI 1) )  GO  TO  35 

292  1 

FRACTP ( N .H > =C . 

2822 

WSA«PY ( J>  »X (  1  ) »T*OP I 

2823 

I  F I  JGM.EO. I  IWSAfDYIJ) 

2929 

IFIFRACRT CN,H» .LT.WSA JGO  TO  35 

2825 

FRACRT (H.M)=0. 

2926 

GO  TO  35 

2927 

389 

1  =  I  NT ( T  X2 ) *  1 

2928 

IFtl.GT.il)  GO  TO  35 

2929 

K<=  I  ♦  1 
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2930 

293  1 

2932 

2933 
2^3** 

2935 

2936 
2  9  3  7 
2  9  3  8 

2939 
29  90 
299  1 

2992 

2993 
2999 

■  2995 
2  ^  * 
299  7 
2998 
2  9  9  9 
2950 
295  1 

2952 

2953 
2959 
2955 
295  4 

2957 

2958 

2959 

2940 

2941 

2942 
2  9  A  3 

294  9 
2945 
2944 

2947 

2948 

2949 
2970 

297  1 

2972 

2973 
2979 
2975 

2974 

2977 

2978 

2979 

2980 

298  1 
2982 

2943 


H« I  APS  <  MfLAG ( K  > (-100 
Nl»!APS|MFLAGlK-l >  )  -  1  DC 
IMMI.LT.0  .Off.  I.EO.t)  GO  TO  394 
*SA  =  OY  t j)*X ( 1-1 J • T«OP I 
IF  (  IGM.EO*  1  1V.SA-0Y  (  J) 

IF(FRACRT !N,Hl ) .LT.WSA1G0  TO  35 
FffACRT (N,NL)*C. 

394  JFIFRACTPIN.FI .LT.TaUII) )  GO  TO  35 
FRACTP(N.M=C. 

GO  TO  35 
C 

c 

C  «•*  REINITIALIZE  f ON  next  SUBPAfKAGE* 

39  Vi Z  =  H 2 ♦  1 

TX3«  T  X { N i H  2 )  ! 

TY3*  TYIN.M2) 

c 

C  •••  INCREMENT  THF  tracer  INOICEs. 

35  M1«M2 
M2*M2*l 

C  **•  LOOP  BACK  TO  BEGINNING* 

IFIM2.LE.NN)  GO  TO  200 
C 

c  ••«  IF  *E  FALL  THROUGH  TO  THIS  POINT,  IT  MEANS  ThAT  THE  LAST 

c  SUbPaCFAGE  OF  THE  NTH  PACKAGE  OID  NOT  MAKE  A  COMPLETE  LOOP. 

WRIll  f  4  i  V  I  0  G )  N 

9100  FORMAT  (4fiH0*«*«.  I Nf  ACE  DETECTED  AN  INCOMPLETE  SUBPACKAGE  OF  MATE 

•  rial  package  ,13/3’iho  check  remaining  packages.) 

PRIN1  9102, Ml  ,M?,NN,TXl  ,TY I  ,TX2,TY2  ,TX3,TY3 

9102  FORMAT!  IOHOMI  , M2, NN=,3I6/2ShDTXI  ,TY1  ,TX2,TY2,TX3,TY3-, 

♦  311X.IP2EI7.8II 

call  exit 

c  *••  END  OF  LOOP  ON  MATERIALS  IN) 

34  CONTINUE 
C 

IF1  INTER. NE. 9)  C-0  TO  362 
DO  36 1  K  =  2 , K M  A  X 
M=MFLAG(K> 

IFIM.LT. 100)  C-0  TO  361 
M  ■  H  -  I  0  0 
J“(K-2)/IMAX+l 
lMK-|)-lfiAx«(J-|) 

W S •  0 Y  <  J  )  •  X  (  I  )  »T4'0P  1  ! 

IF  (  IGM.EC.  1  1  IF  S  3  0  Y  (J) 

Y.R1TEI6,  1666)  I  ,J,  I  All  1  I  1  «*S,  (FRACTptN.MI  ,FRACRT  (N,Mj  ,N«  1  ,  NVOlD  > 
1666  FORMAT  (  1  9h  I  ,  J  ,  T  A U  ,  X D Y  2P  I  ,  -  ,  2  I  6 , 1  P 2 E 20 . 8 /  1  0 X  ,  1  OH  F  R  ACT P  .  J  OX'. 

I  10H  FRACRT/I 1P2F20.8)  ) 

341  CONTINUE 
362  CONTINUE 

C  •*•  MAKF  FLAGS  .GT.  100  NEGATIVE.  THEN; MaKE  POSITIVE 

C  FLAGS  OF  CELLS  V.JTH  AN  INTERCEPT  ON  0NE  OF  ITS 

C  BOUNDARIES.  THUS  AFTER  THIS  LOOP,  A  CELL  A'  I  1 H 

C  A  NEGATIVE  FLAG  NO  LONGER  IS  CUT  BY  AN  INTERFACE 

c  ant  has  pecon).  pure,  its  flag  pul:  mot  be  redefined 
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2484 

2485 

2486 

2487 

2488 

2489 

2490 

2491 

2492 

2493 
2491 
2  4  9  5 

2496 

2497 

2498 

2499 
2800 
2501 
250? 

2503 

2504 

2505 

2506 

2507 

2508 
2  5  C  9 
25  I  0 

251  1 
25  1  2 
2513 
25  1  4 
2515 
25  1  6 
25  1  7 
25  1  8 

2519 

2520 

252  1 

2522 

2523 

2524 

2525 

2526 

2527 

2528 

2529 

2530 

2531 

2532 

2533 
25  3  4 

2535 

2536 

2537 


C  UNTIL  THE  Fko  OF  FH2. 

C 

00  382  t«l  ill 
DO  38  J« 1  ,  I  2 
K" I J- |  ) • I  MAX* | ♦ J 
Ma  I  A  85  (  MFLAG  (  K  )  ) 

IFM.lt. 100)  f.O  TO  38 

mflagikm-m 

MBs  I ARS f Mf LAG! K -IHAt I  1-100 
MLalABSCMFLAf,  <K-1  >  1-100 
1 00 
C 

DO  37  N  « 1  ,  N  V  0  T  0 

IFtN.NF.NVOJD  .and.  XMASS 1 NiM  )  .LE.O.  )  60  TO  37 
rtSAaFffACTf'M.Ml 
H  S  V  a  T  A  U  1  1  ) 

JFIv.SA.GT.0.  .AMO.  ASA.LT.WbY)  GO  TO  378 

ASBeFRACRTIN.H) 

ft  S  X  =  0  Y  (  J  )  •  X  (  J  )  •  T  A  0  P  1 

IF  UGH. EQ-  1  I  ft  S  X  =  0  Y  (  J  1 

I F  (  u  S  f;  .  G  T  .  0  .  .AND.  W5B.LT.6SX)  GO  TO  378 
IFM8.LT.0  .OR.  j  .  E  0  .  |  )  f,i)  TO  377 
*  S  A  a  F  R  A  C  T  P  <  H  ,  m  r,  ) 

IF  (  -V  5  A  .  G  T  •  0  .  .AHO.  WSA.LT.WSY>  GO  TO  378 

377  IFIHL.LT.O  .09.  I  . E Q .  1  )  GO  TO  37 

wSb  =  fracRtin,:il) 

«SX»DY{J)aX(!-l  I  •  T.J  0  P  1 
IF!  I  GM.E'Q.  1  )  A  5  X  a  D  Y  (  J  ) 

I  F  1  Vi S 0  •  G T  » 0  ,  .AND.  VS B  •  LT  .  AS X  )  GO  TO  378 

37  CONTINUE 
GC  TO  38 

378  MFL AG ( K ) =  M  + 1 00 

38  CONTINUE 
382  CONTINUE 

IF!  INTER.E3.0l  GO  TO  380 
ft'  ft  I  T  F  (  6 . 6  7  8  ) 

DO  384  J»l .UMAX 
N  B  a  (  J  -  I  )  •  I  A  A  x  ♦  2 
N  £  *  N  B  ♦  IMAX-1 

,V«ITEt6,679)  (  H  F  L  A  G  (  K  )  <KaNB,NEI 

3B4  CONTINUE' 

6  7  8  FORMAT  (J2H  MELA3  ARRAY?) 

679  FORMAT  <  32 1 4  » 

380  CONTINUE 

C  •••  LOOK  FOR  CELLS  THAT  v*lLt.  BE  MIXED  ON  NEXT  C'TCLE 

C  (POSITIVE  FLAGS).  BUT  SHOULD  BE  EVACUATED  OF  ONE  OR 

C  MORE  MATERIALS.  The  density  of  MATERIALS  TO  BE 

C  EVACUATED  V1LL  HE  SET  TO  2EH0. 

DO  390  I  a  1  ,  j  1 
00  39  J=  1  ,  I  2 
K  =  (  J-  I  )  •  MAX*  t  ♦  | 

MaMFLAS(K) 

C  IF  FLAG  IS  NEGATIVE,  EVACUATION  FLAGS  SET  IN  ANOTHER 

C  LOOP. 
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25  3  8 
2539 
2590 
25*1 

2592 

2593 
2599 

2595 

2596 

2597 

2598 

2599 

2550 

2551 

2552 

2553 
2559 
2555 
2558 
2567 

2558 

2559 

2560 

256  1 

2562 

2563 
2569 
2565 
25  66 

2567 

2568 

2569 

2570 

257  1 
2572 
25  7  3 
2579 

2575 

2576 

257  7 

2578 

2579 
25  80 

258  1 
2592 
2583 
2589 
2588 
2598 
2587 
2  5  9  9 
25  3  9 
25  90 

259  1 


IF  CM. LT. 100)  60  TO  39 
M*M-1Q0 

MB*  1  A0S  fHFLAG(K-lMAX)  1-130 
ML»1ABS|HfL/i6CK-1  )  1-10Q 
00  385  N»1 .NMaT 

IFf XMaSSIN.M) .LE.O.  )  GO  TO  385 

IT.Sa*FR  ACT?  (  0,91 

WSY-TAUfll 

IFIwSa.gT.O.  .  AND  .  w5A.LT.WSY)  go  to  385 
Y.SBaFR  ACRT  C  N  ,  M  I  > 

WSX=DY  C  J  1  *X  (  1  )  •T.VOPI 
IF<IGM.£Q.IMSX*OY<J| 

IFIASfl.GT.O.  .AND.  VSB.LT.WSX)  GO  TO  385 
lFfMB.LT. 3  .08.  J.EQ.l)  GO  TO  381 
ASA»FRAcTP(NiMS) 

I  F  ( -A  s  A  .  G  T  .  3  .  .AND.  aiSA.LT.W5Y1  GO  TO  385 
381  IFtML.LT. 3  .OR.  I.EQ.l)  GO  TO  383 
«SR*FRACi7TtN,9Ll 
WSX*DY(j)*X( f-l  1 • T  A  o  P I 
IF(IGM.E'3.IMSX*DY(J) 

IFUSa.ST.O,  .ANO.  WS9.LT. USX)  GO  TO  385 
383  RH0CN,M)"3» 

385  CONTINUE 
39  CONTINUE 
390  CONTINUE 
C 

C  REDEFINE  FRACTP  ANO  FKacRT  FOR  CELLS  THAT  ARE 

C  NO  LONGER  MIXED  (FLAG  NEGATIVE)  BUT  WILL  STILL 

C  BE  PROCESSED  AS  MIXED  CELLS  UNTIL  THE  END  OF  PH2. 

C 

DO  980  1*1  i  I  1 
DO  98  1  ,  I  2 

K*l J-| )*IMAX+ J*| 

C  ***  IF  CELL  HAS  NEGATIVE  FLAG  IT  LOST  ALL  INTERFACES 

c  during  this  subcycle 

MN»3 
N  M  *  0 

IFCMFLAGlO «GE«3t  GO  TO  98 
MA» I ABS ( MFLAG f <♦ I  MAX )  ) 

MR*  I  ABS  (  MFI.AG  (  <  ♦  11) 

Mil*  I  A|)S  (  MFLAG  I  K-  1  MAX  I  ) 

ML= I  A  3  S ( MFLAG  <  K- I  I  ) 

C  ♦  CELL  'VILL  OE  PURE  OF  SAiE  MATERIAL  AS  ONf  OF  its  PURE 

c  neighbors  or  one  of  its  m  y  x  e  d  neighbors  on  the 

C  LEFT  OR  BELJiV. 

IFfI.EO.IHAX  .AND.'  J.tO.JMAX)  GO  TO  9115 
IFlHA.GT.lOn  .OR.  J.EO.JMAX)  GO  TO  8)0 
N  M  »  M  A 
GO  TO  915 

9 1 0  IFfMR.GT.fOO  .OR.  I.E3.IMAX)  GO  TO  911 
H  M  a  M  R 

GO  TO  915 

911  IFfl.EQ.l  «ANO.  J.ER.ll  GO  TO  915 

9  115  IFfMB.GT.lOQ  .OR.  J.eq.fl  GO  TO  9  I  _•> 
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2592 

NMwMB 

2593 

GO  TO  915 

2594 

912 

IFfHL.GT. |00  »  OR  «  l.EO* 

n  GO  TO  413 

2595 

MM=  ML 

2594 

GO  TO  9 | 5 

2597 

913 

tf ( J.EO. 1 )  GO  TO  919 

2598 

MN»MB-100 

2599 

GO  TO  9193 

2600 

9  |  9 

IF<  I  ,EQ, 1  )  GO  TO  9190 

2601 

MNsML-100 

2602 

GO  TO  9193 

2603 

9  190 

l»R  I  TE  <  6 , 960  )  I.J 

2  4  0  9 

call  exit 

2405 

C 

- 

2606 

9193 

1)0  9  196  W  »  1  jHVOll) 

2607 

I F  C J.E3.1 )  60  TO  9194 

2603 

l  F  (  F  R  A  C  T  P  1  N  » M  N  )  .GT.O.  1 

go  to  ‘iha 

2609 

GO  TO  4146 

26  10 

9  199 

1F(FRaCRT(M,MM» .GT.O. 1 

GO  TO  HIHR 

2611 

9  196 

COtIT  I  NUE 

26  12 

IYRITE16.940I  I.J 

26  13 

call  exit 

24  1  9 

C 

26  15 

9  198 

N  M  =  N 

2616 

9  15 

IKINM.Ea.Ol  H  M ■ N  V  0 l 0 

24  1  7 

H*IARS(MF  L’A  6  1  K  1  1-100 

2618 

MB«MB- 1  no 

2619 

M  L  *  M  L  -  1 00 

2420 

C 

2421 

93 

00  46  NaJ  »  M  V  0  1  D 

26  22 

1FIN.NE.NM)  GO  TO  44 

2623 

FRACTP1N.I1)  ■  T  A  U  (  1  ) 

2629 

FRACRT(N.M)  *  D>  1  J  )  «X  1  1)  ♦TW0P1 

2625 

IF (  K.M.EU. 1 1FPACRT1N ,Mi»or IJI 

2626 

IFIMB.LT.O  .08.  J.ER. 1 ) 

GO  TO  431 

2427 

FRACTP ( N ,MB) ■TAU 1 1 1 

2628 

93  1 

IF  1  ML. LT .0  .OR.  I  .EG, 1  ) 

(,0  TO  46 

2429 

FRACRT 1 N  .  H  L ) ■ P  7 1  J  )  •  X  ( I” 

1 1  *  T  if;  0  P I 

2630 

IFI  !  GH  .EN.  1  )  FRACRT  1  M  ,ML  1  =f'T  (  J» 

263  1 

GO  TO  46 

2632 

99 

RH0(N,M)=0. 

2633 

44 

COMT 1  MJE 

2639 

C 

•  ••  CNP  Or  LOOP 

ON  K  FOR  CEiLS  WITH  NEGATIVE  FLAG 

2635 

411 

CONI  1  NOE 

2636 

980 

continue 

- 

2437 

IF  tl.J.GT  .  1  )  GO  TO  4  9 

2638 

C 

2639 

c 

IF  THIS  IS  FIRST  SUucYCi.E  OF  I NF  A  C  E  .  C  OMPUT  E 

2690 

c 

FLUXES  OF  MATfKIAl.  To  Pt  EVACUATED  USING  FLUX 

269  1 

c 

TER  !■'  5  FROM  LAST  CYCLE.  INITIALIZE  FLUX  TERMS 

2692 

r 

of  other  materials. 

269.3 

C 

24  9  4 

DO  4  8li0  1  =  1,1) 

* 

2695 

00  4Hfl  J= l  .  1  2 
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26**  A  K*(J«l  1  •  I  h  A  X  +  I  ♦  |  -  -  . . 

26*t7  M«lABS(MfLAG<K) 1-100 

2688  IFIM.LT.01  GO  TO  **88 

2689  M8*0 

2650  1FIJ.GT.11  MB»MFLaG(K-IMAX)-100 

2651  ML»MFLAG(K-I  1-100  j 

2652  C  .  . 

2653  DO  886  N=1 iMMAT 

2658  IF(RHO(N*Ml .GT.C.  .OR.  XM ASS J N , M ) ,t E .0 .  )  GO  TO  806 

2655  TFLUX*0. 

2656  FR  =  0.  .  . -  '  . 

2657  F T*0  • 

2658  .  FL  =  0.  . . . -  ■  ~~  - - . • 

2659  FB«0. 

2660  OIFF*XMaSS(N,MJ 

2661  C 

2662  HR= JABS(MFLA6(K+1 1) 

2663  IFISAMMPINiHl.LE.O.  ,0R.  (HR.LT.lOo  .AND.  I.LT.jHAXl)  GO  TO  **82 

2668  FR  =  SAHMP  ( N  i  H  1  ‘  . 

2665  TFLUX*TFLUX»FP 

2666  XMASS(N,H1*-DIFF 

2667  C 

2668  982  HA«1ABS(HFLAG(K*1HAX> 1 

2669  IF ( SAHPY I N  ,H  )  .UE.O.  .OR.  (MA.LT.10c  .AND*  J.LT.jMAXl)  GO  TO  883 

267  0  ft*  Samp  y ( n  *  m )  } 

2671  TFLUX*TF»UX *FT  ' 

2672  XMA5S(H,M)*-0IFF 

2673  C 

2678  883  I F (  I  ,  EQ  >  l  .OR.  PL.LT.O  .OR.  RHO ( N , rl ) . LE . 0 ,  .OR, 

2675  I  SAHMP ( N  ,  ML) .GE.C. |  60  TO  888 

2 676  FL*-SAMMP ( N ,ML 1  - . , 

2677  TFLUX=TfLUX+FL 

2678  XHASS(N,ML>«-ABS(XMASS<N,ML!) 

2679  C 

2660  988  IFIJ.eo.i  .or,  H6.LE.0  .OR.  RHO ( N , m8 > . LE » 0 .  .OR, 

2681  1  SAPPY  I N ,M8 ) ,GE  .O.  I  GO  TO  885 

2  682  FB  =  -SaMPY  ( N  ,Mp  |  .  •... 

2683  TFLUX=TFL0X+F 0 

2668  XMASS ( N , MB  I »-ABS ( XMASS ( N , NB 1 1  . 

2665  C 

2606  885  IFITFLUX-LE.O. J  GO  TO  886 

2687  C 

2668  C  . 

2669  6S=D1FF/TFLUX 

2690  C 

2691  SAMMP(N,M)=FR«tt5 

2692  SAMPY ( N ,M 1 *FT»WS  . 

2693  IF(FL.6T«0«)  SAMMP < N , ML ) *-FL««S 

2698  If IFB.GT.O, 1  SAMPY  < M , MB ) *-F6»«S 

2695  986  CONTINUE 

2696  98e  CONTINUE 

2697  9800  CONTINUE 

2698  00  890  MM.NMXCIS 

26*»9  00  889  N=1  ,NNAT 
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2700 

XMaXMASS  1  ft  ,  0  1 

2701 

IF1XM.LT. 0.1  GO  TO  989 

2702 

SAMP Y 1 N . M 1  a  C« 

2703 

SAMMP(N.M)  a  C. 

2709 

989 

XMASS(N,M>  a  ARS(XM) 

2705 

990 

CONTINUE 

2  70  6 

C 

2707 

c< 

1  •  •  • 

2708 

c 

2709 

c 

COMPUTE  FLUXES  FOR  CELLS  CONTAINING  INTERFACES 

• 

2710 

c 

271  1 

c 

•••  cyc  rs  factor  in  flux  equations  and  is  .gt.  i 

FOR 

27  1  2 

c 

CEILS  that  HECOME  MIXED  AFTER  FIRST  SUBCYCLE. 

27  1  3 

c 

(CYC.GT.l  ONLY  WHEN  FLUX  CALLED  FROM  NEWMJX) 

271** 

99 

CYC  a  1, 

27  15 

00  100  1=1.11 

27  16 

DO  60  U" 1 . 12 

2717 

K» 1 J-l »  * IMAX  +  1 ♦ 1 

27  1  8 

c 

IF  CELL  K  IS  NOT  MIXED,  SKIP  OUT. 

27  1  9 

MFK» 1 ABS ( MFLAG1K 1 1 

2720 

I F ( MFK ,LT  .  1 00 )  GO  TO  60 

272  1 

c 

•••  DEFINE  LOCATION  IN  MjXEo  ARRAYS  OF  INFO,  ON  CELL  K 

2722 

MaMFK-100 

2723 

c 

•••  DEFINE  INDICES  OF  CELLS  ABOVE  AND  ON  RIGhT 

2729 

KRaK* I 

2725 

K AaK  +  I  MAX 

2726 

MA-1ABS<HFLAG(Ka1 ) 

T 

2727 

MR»1A&S(MFLAG(KR) ) 

2728 

c 

•••  IF  CELL  K  CONTAINS  A  FRfE  SURFACE  SET  IFSl  ■  l 

2729 

IFSlaO 

2730 

IFLRHOtNVOlD.nl. 6T.0.I  IFS1-I 

2731 

CALL  FLUX 

2732 

50 

CONTINUE 

2733 

c 

...  end  OF  j-loop 

2738 

60 

CONTINUE 

27  35 

c 

•  ••  EN0  OF  I  -LOOP 

2736 

100 

CONTI NUE 

2737 

c 

2738 

c» 

•  •  •  * 

2739 

c 

2790 

c 

*••  MOVE  TRACERS. 

278  1 

c 

2792 

NVPaNvGJD+1 

2793 

c 

WHEN  NTCC.GT.l,  PASSIVE  CELL  CENTERED  TRACERS 

(XP.TPl 

2789 

c 

ARE  BEING  PROCESSED. 

2795 

c 

*HEN  NTCCsO,  THESE  TRACERS  HAVE  NOT  BEEN  GENERATED , 

2796 

DO  730  N «  l  *  ti V P 

2797 

NNaNMP ( N ) 

2798 

IFIN.GT.MVOjDl  nn«ntcc 

2799 

I  F  1  N N  .  EG  » 0  1  C-0  TO  7  3  0 

2750 

00  7  2  0  L  *  1  .  -I  fi 

275  1 

t 

•  ••  FIND  1  A  NO  J  OF  CELL  TRaCER  IS  IN  BEFORE  IT  IS 

moved* 

2752 

I  F  1 1. .  L  T  .  N V P  |  GO  TO  9  9  1  . 

2753 

IM'  TtxfUL)  1  +  1 

53 


2759 

2755 

2756 

2757 

2758 

2759 

2760 

2761 
27  6  2 
2763 
276M 
2  7  6  S 
2766 

2767 

2768 

2769 

2770 

277  1 

2772 

2773 
2  7  7  9 

2775 

2776 

2777 
27  78 
27  79 
2760 

278  1 
2702 
2  7  P  3 
27  09 
2785 
2706 
2767 

2788 

2789 

2790 

2791 

2792 

2793 
2799 

2795 

2796 

2797 

2798 

2799 
2000 
2001 
2602 
2803 
2009 
2605 
2PI16 
2  0  U  7 


I  NT ( VP  1  L  I  ) ♦ 1 
60  70  992 

991  CONTINUE 
1°INT(Tk(N»L1 1+| 

1 F ( TX ( N ,L I .6E*FL0AT ( IMAX ) • ANO. ABS ( TX ( N,L l-A INT ( TX  <N.L >  M  ,LE.O.  I 
I  I  *  I  -  1 

J*  I  NT  <  TY  I  N  ,L  >  )  +  1 

C  IF  TRACER  IS  OUTSIDE  GRID,  SKIP  OUT. 

992  CONTINUE 

IFI1.GT.I1  .CR.  J.GT.I2  .OR.  J.LT.O)  GO  TO  720 
C 

K» ( J-l 1 • I  MAX ♦ 1  +  I 

P*IAPS(MFtAG(K) 1-100  1 

C 

C  •••  STORE  FRACTIONAL  PARTS  OF  THE  COORDINATES  IN  FRX.FRT 

C 

IF  (N.I.T.NVP)  GO  TO  993 
pRX  «  XPlL)-AlNT(XPIL) 1 
FRY  »  vP  <L 1 -A  I  NT  C YP (L  I  > 

GO  TO  999 

993  CONTINUE 

FRX»TX(f!,L)-AINT(TX(N,Ll> 

F  R  T  «  TYIN.Ll  -  A INTITY(N.L)  ) 

999  CONTINUE 

V,  SXaARSlFRX-.S) 

V.SY*AbStFRY-.57 

c  CEFINE  INDICES  OF  NEIGHBOR  CELLS.  : 

KH«K  +  1 
KV=K*IMAX 

IF (FRY.lt. ( .5) )  KV-K-IMAX 
KD«KV*1 

I F ( FRX.GE. ( .5) I  GO  TO  500 
KH.K-I 
KP«KV-| 
faOQ  CONTINUE 

c  •••  INDICES  of  CELLS  OUTSIDE  THE  GRID  i 

IF(J.GT.l)  GO  TO  505 
KV*MAXO ( K ,KV I 
KO»MAXO(KH,KD) 

505  IFIJ.LT.JMAX)  GO  TO  5)0 
K Vo M| NO [K  ,KV ) 

KDbMINUIKH.KO* 

510  IFII.6T.I)  f,0  TO  SIS 
KHskiAXO(K.KH) 

KD*MAX0(KD,KV ) 

515  IF(  I  ,UT.  1MAXI  GO  TO  520 
K  H  =  M I  NO ( K  ,KH ) 

K  l>*  MINO(KV.KD) 

620  CONTINUE 

C  *••  DEFINE  WEIGHTING  FACTORS 

WH  =  0. 

V.V  =  0. 

*D»0. 


2pne 

WFS-O. 

2809 

IF<  AMX  (KH  1  .&T.C.  1  ‘•tH-SVSX*  (  1 .O-tVSY  1 

28  10 

IF1AMXIKVI.6T.C.)  *va#SY* 1 |  .O-WSX  1 

28  1  1 

IFlAMXlKUl.GT.O.I  Wpa*SX*ftSY 

281  2 

]  F  I  A  MX  I  F  1  «  GT  »  P  .  1  AK*I l •  C  •  W  S  Y 1* ( T  •  0  -  ft  5  X ) 

2813 

C 

•  ••  SUM  weighting  factors 

28  1 

If.’  F  5  «  IVH  *  "V  ♦  CO  ♦  IKK 

28  15 

IFUFS.Lt.O.  1  GO  TO  720 

2616 

C 

CALCULATE  RAO  I A  L  VELOCITY  OF  THE  TRACER. 

2?  1  7 

IFII.GT.l  .OR,  FPX.GE.U5>!  GO  TO  603 

2  C  1  8 

»Ha-ft  ,| 

28  1  9 

V,  0  *  -  V  0 

2620 

603 

CONTINUE 

282  1 

UEFF*  (  U  |  KH  »  »*H  *  U(KV)»V.V  ♦  UIKD)*ftD  ♦  U  (  K  )  *Wk  1  /  AFS 

2822 

•>  M  a  A  B  5  1  ii  HI 

2623 

ivd«abs  t  viO) 

2629 

c 

••*  CALCULATE  AXIAL  VELOCITY  OF  THE  TRACER. 

2825 

TFTj.gT.I  .or.  CVIS.LT.O.  .OR.  FRY.GE.U5l  >  GO  TO  6n9 

2826 

*  V  «  -  6  V 

2827 

VO*- ft  0 

2828 

6  0  9 

CONTINUE 

2829 

VEFF  »  (  V  (  KH  1  «.»H  +  V(KV)*5V  ♦  V(K01*A0  +  V  (  K  )  ♦  ft*  ) /ftp  S 

2830 

605 

CONTI  NUf; 

283  1 

c 

•••  STOP  E  N  F ft  TRACER  COORDINATES 

2832 

IF  (APS (UEFF) .LT.MHIN)  UEFF-O. 

2833 

IF  (  ABS  1  VEf  F  1  .t.T  .UHIN  1  V£FF“0. 

2838 

DISTX  «  UEFF  •  S  0  T 

2835 

OISTY  *  VEFF»SOT 

2836 

HOSX  a  xd-ll  *  t)  X  <  I  1*FRX  +  DISTX 

2837 

P05Y  «  Y<J-1>  ♦  OYIjUFRY  ♦  DISTY 

2038 

c 

•  DO  NOT  A  L  L  0  M  TRACERS  TO  MOVE  OFF  OF  AXIS. 

2839 

IF  l  TX  (  N  ,L  1  .LE  .0.  .A'to.  N.LT.NVP)  r,0  TO  709 

2  a  9  0 

IF t POSX .GT.X ( ! 1 1G0  TO  7C5 

28 ‘11 

1FIU0SX.lt.> (  f-1  )  .AND.  UGT.11  60  TO  707 

289  2 

IF  (M.  Cl!'.  NV  PI  GO  TO  70  9 

2  8 '(3 

TX<N,L)  =  T  X  ( f.  ,  L  )  *  D1STX/DXU) 

286  8 

GO  TO  7  Cl  9 

2095 

709 

XP(LlaXP<Ll+0  1STX/l>X(  I  1 

2866 

GO  TO  7  0  9 

2867 

705 

16tN.EQ.NVP)  r,0  TO  7C  6 

2868 

TXIti.LI  =  F  L.  0  A  T  (  1  1  ♦  (  POSX-X  (  1  1  1V0X  (  I  ♦  1  ) 

2869 

GO  TO  709 

2850 

7  06 

XP(L)aFLOAT (  l  )*(POSX-X( I 1  I  /  D  X  (  |»t  ) 

2851 

GO  TO  709 

2862 

707 

IF(N.EQ.NVP)  GO  TO  708 

2653 

TX(n,l)  =  F  L  0  a  T (  1 “ 2 )  +  t.C  -  < X 1 I-l J -PpSX )/0X I I-l 1 

2866 

GO  TO  7  G  9 

7B5S 

708 

XPt  u  =  FLOAT  (  1-2  1  ♦  1 .0-  (  M  1-n-POSX  l/px  c  I-l  ) 

2856 

c 

2057 

c 

■•••'*  CO  NOT  ALIO-  TRACERS  TO  MOVE  OFF  OF  >X[S. 

2868 

70  9 

I  F  t  T  Y  (  ,  L  1  •  L  6:  .  0  .  .A  HO,  N.LT.NVP)  GO  TO  606 

2869 

I  F  (  POSY  .  CiT  .  Y  (  J  )  1  GO  TO  711 

2060 

I F l POSY . LT « Y < J- 1 1  .ANn.  J.GT.tl  GO  TO  713 

286  1 

It  In.  k  CJ  .  u  V  P  1  oi  to  tic 
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2062 

TY<N,L>  ■  TY(N.L)  ♦  P1STY/0YIJI 

2  8  6  3 

GO  TO  715  j 

20  A  8 

710 

YP < L > »Yp < L ) +0 1 STY/OY < J >  ! 

2  0  6  5 

GO  TO  7 1 5 

2866 

7  1  l 

1FIN.EQ.NVPI  GO  TO  712  •  '  . 

2P67 

T.YIN.l)  *  FuOATfJI  ♦  <POSY-Y(  J1)/0Y(  J*l  » 

2P  6  0 

GO  TO  7  lb  ’ 

2069 

712 

YP(L)bFLOaT( JJ-mPOSY-Y( J) 170Y( J+l ) 

2870 

GO  TO  716 

2871 

7  13 

IFIN.EQ.NVP1  0,0  TO  719 

20  7  2 

T  Y  (  N  ,  L  f "  3*  KLOATlJ-2)  ♦  1.0  *  1  Y  1  J- |  ) -POS  Y  > /D  Y  1  J- 1  ) 

287  1 

GO  TO  7  lb 

20  78 

719 

YP|L)sFlOAT(  ,1-21  +  1. 0-(t(J-l>-POSY»/07(J-l)  j 

2875 

7  15 

CONTINUE  •• 

2076 

V 

IFIN.LT.UVP)  0,0  TO  606 

2077 

|FUP(L)»LT.0.1  X  P  « 1. )  «  0  . 

26  78 

1F1  TP  1 1 )  .f,T  .0.  •  AMDiXP  (L  >  .  LE.  FLOAT  (  jmAX  1  •  AND.  YP<l  )  .Lr  .FLOAT  U/MAX  )  > 

2879 

GO  To  607 

2080 

XP(L>oO. 

208  1 

YPlLlsO. 

2882 

GO  TO  607 

2803 

606 

CONTINUE 

2689 

c 

•••  IF  TRaCEP  CROSSED  AXIS,  PUT  IT  BACK  ON  AXIS. 

2805 

IFITXIN.D.LT.O.)  TX(N,.L)  ■  0. 

2806 

IF  (  TY  (N,L  >  .I.T.C.  1  TY(N,LI«0, 

2  b  0  7 

607 

CONTINUE 

2088 

c 

END  OF  LOOP  ON  L 

2809 

720 

CONTINUE 

2890 

c 

••»  end  of  loop  on  materials  <mni 

289  1- 

730 

continue  ! 

2892 

c 

*••  f  NO  OF  SUBCYCLE  LOOP 

2893 

075 

CONTINUE 

2699 

c 

»•+  IF  IMFACE  IS  NOT  BEING  SUBCYCLED  (ICY-1), 

2895 

c 

THE  FLUX  TERMS  OF  CELLS  BEING  EVACUATED  OF  A 

2896 

c 

MATERIAL  HAVE  ALREADY  BEEN  ADJUSTED  (SEE  BEL06 

2897 

c 

STaTFMENT  000). 

2690 

!F(  ICY.EQ*  1  »  GO  TO  9600 

2899 

c 

I 

2900 

c. 

*  ♦  • 

290  1 

c 

INTERFACE. 

2902 

c 

1 

2903 

DO  9500  1=1,11 

2909 

00  950  J= 1  ,  1 2 

29  05 

K  =  ( J- 1  )  • l MAX* I ♦ | 

290  6 

M= 1 ABS ( Mf  LAG ( K 1  1 

2  90  7 

IF1M.LT. 100)  GO  TO  950 

2900 

M=M- 1 00 

2909 

c 

ADJUST  FLUX  OF  EACH  MATfRIAL 

29(0 

DO  9HU  N=) iNMAT 

29  1  l 

c 

«*•  IF  X  M  A  S  5  t  N , M )  .GT.  0.  ,  BUT  RHOIN.M)  »  0.,  MATERIAL 

29  l  2 

c 

N  IS  TO  PE  EVACUATED. 

29  1  3 

IF ( XMaSS < M.M ) .LF. 0. )  GO  TO  990 

2919 

IF (RHO(N.H) .GT.O. )  GO  TO  990 

2  93  5 

M  e  =  C  1 

i 


i 
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29  16 
2912 
29|8 

2919 

2920 

2921 

2922 

2923 
2978 

2975 

2976 

2927 

2928 

2929 
29  30 
293  1 
2932 
7933 
2939 
2935 
2  9  3  A 
2937 
7938 
2939 

2980 

2981 

2982 

2983 
2999 
2  9  9  5 
299  4 

2997 

2998 

2999 
2950 
296  1 

2962 
2953 
2959 

2955 

2956 

2957 
2558 

2959 

2960 
296  1 
2  962 

2963 
2969 

2965 

2966 

2967 

2968 

2969 


lFtJ.GT.ll  MB«MFLA6<|i>lMAXl-tQ0 
HI. ■MFLAGCK-I  >-100 
TFLt/X»0, 
f  R  °  0  • 

FT-0. 

FL«0.  . 

fb«d. 

c 

IF ( S  AMMP  <  N , M )  . LE  «  0  • 1  GO  TO  880 
f  R=SAMMPtN,M) 

TFLUXaTFLUX*FR3 

C 

880  lFtSAMPytNiHl.LE.0.1  60  TO  885 
FTbSAMPV(N.h) 

TFLUX=TFLUX*FT 

c 

885  IFtl.FQ. 1  .OR.  ML.LT.O  ,DR.  RHO t N . ML  1 . LE . 0 •  .OR. 

1  S AMMp t N *  ML ) • GE • 0 . )  GO  TO  890 
FL*-SAMIlP  (  N  ,Mt.  1 
TFLUX  =  TfLUX  +  F1. 

c 

890  IFIJ.EQ.l  .OR.  MB.LF.O  .OR*  RHOtH.HBl.tE.O.  .OR. 

1  5AMPY < M  ,ht 1 .GE«0. 1  GO  TO  895 
Fb»-SAMPY<N,Hfil 
TFLUXaTFLUX.FF 
C 

895  IFtTFLUX.GT.O. )  GO  TO  9C0 
GO  TO  990 
C 

900  SAMMY (N)a0. 

SGAMCtN, Jl«0. 

IF C | ARS (MFLA6IK-1MAX 1 1 .lT. 100  .OR.  J.EU.l)  GO  TO  905 
Mb«  i  xr.s  t  mflag  <  k- imax  )  1-100 
SAMMY  t N 1 =SAmPy  t N ,M8 1 

c 

90b  I  f  (  1  ABS  t  MFLAG  (  1C- 1  )  1  .LT  .  1  00  .OR.  I.pQ.U  GO  TO  910 
ML»IAhS(MFLAG(K-ll)-IOO 
SGAMCtN, J |»SA MNP I A),  ML 1 
C 

910  0!Ff-«XMASS<N,M>-SAHPY<N,M)-5AMMP(N,M>+SAMMY<N)YSGAMctNiJ) 

C 

tVS*DIFF/TFLUX 

c 

S  A  M l:P  I  N  ,  M  I  «F  R  «  f-' S  ♦  5  A  h MP  1  M  ,  M  1 
5AMPV(M,MI»FT*l/S*SAMPYtN,Ml 

IFtFL.GT.0.1  9AMMP(ri,ML)=-FL»PS+SAMMPtN,ML) 

1  F  (  F  t>  .  GT  •  0  •  1  rAM|’Y  t  M  ,  MM  1  «-Fe»'*S*SAHP  Y  f  N  ,MR  1 

..R  I  Tt  (  6 ,999  I  )  J,  J,  K  ,  M.  ML,  MR,  DIFF,  Xm  ASS  t  li  ,  M)  »  SAMMY(nI> 

1  SGAMCtN, J),  SamPY(N.N).  SaMMPIN.M),  SaNPYIM.MPI.  qAMMP(M,ML) 

9901  FORMAT  t  25(1  f  V  A  C  M  A  T  1  P  N  OF  MATERIAL  N/I8M  1  ,  J  ,  M  .  M  ,  ML  .  Mfi  ,  6  I  4  / 

1  3  G  H  M  I  F  ,  XMASS  t  N  ,  il  J  ,  SAMMY  t  n  1  ,SGAPC  t  N  ,  J  >  ,  1  P8E20 ,8/ 

2  96H  SV,MPY(NtM>  .SaMMPIN.M)  ,  S  AMP  Y  (  N  ,  MB  )  ,  5  AMUR  t  N  ,rt'L  1  , 

3  •  1  P  9  E  2  C  .  B  1 

96(1  fora  AT  (  631,  T  p  n  I :  I,  |_  l  ,  ,  r  I  'I  i  IK,  MATERIAL  <T  CELL  THAT  n  A  S  UECOMt  POHf, 
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i 


i 


2970 

1 

1  1  ,  J  ■  ,  2  t  0  | 

297  1 

C 

•••  END  OF  LOOP  ON  MATERIAL,  ! 

2972 

900 

CONTINUE 

2973 

C 

•••  ENO  Of  LOOP  ON  K  (CELLS), 

2  9  7  H 

950 

CONTINUE 

2975 

'  9500 

CONTINUE 

2976 

•  9600 

RETURN 

2977 

ENO  ^ 

2970 

SUBROUTINE  INPUT  ) 

2979 

C 

•••  READ  RESTART  TaPE. 

2  9  8  0 

C 

•••  CALL  CAROS  TO  READ  1 NPUT  DECK .  ;  PR  1  NT  INPUT  VARIABLES, 

298  1 

c 

•••  DEFINE  constants 

2982 

c 

CALL  SETUP  TO  DEFINE  CELL  QUANTITIES  AT  TIME-Q. 

2983 

INCLUDE  COMDIM  j. 

2989 

c 

! 

29es 

K  UN  I T  R  «  7 

2986 

KUNI  T8.«7 

2907 

c 

•  ••  RE  At)  AND  PRINT  10  HEADING  CARD  (FIRST  CARD  IN 

2980 

c 

INPUT  DECK) 

2989 

READ  (5,370)  IMS 

2990 

WRITE  (6,370)  IAS 

299  1 

c 

•••  CARDS  ROUTINE  WILL  READ  AND  PRINT  FIRST  DATA.  CARD* 

2992 

CALL  CAROS 

2993 

c 

pk(3j.lt.o,  means  this  problem  is  being  restarted  f«om 

2990 

c 

the  restart  Tape  and  setup  is  not  needed. 

2995 

IF  t PK ( 3 ) .LT.O* )  GO  TO  70 

2996 

CALL  CARDS 

2997 

c 

Z<l)=PROO  IS  DEFINED  BY  THE  SECOND  CARO  OF  A  SETUP 

2998 

c 

DECK, BUT  IS  NOT  DEFINED  IN  A  RESTART  DECK, 

2999 

5 

IFIPROB.EQ.O, )G0  TO  230  I 

30C0 

CALL  SETUP 

300  1 

GO  TO  70 

3002 

lo 

CONTINUE 

3003 

CALL  CARDS 

3000 

c 

•**  INITIALIZE  P-STQRAGE.  ‘ 

3005 

20 

DO  30  K  =  l  ,  K H  A  X  A  ' 

3006 

3r| 

P ( K ) *0 , 0 

3007 

C 

«•«  SET  T  AND  NC  SO  ThEY  *UL  EQUAL  ZERO  ON  FIRST  EDIT 

3  0  C  9 

c 

PRINT  AFTER  BE l ng  incremented  by  COT, 

3009 

T  *  T “0  T  N A 

3010 

NCsNC-l 

30  1  1 

c 

CHFCK  FATAL  INPUT  ERRORS. 

30  1  2 

3a 

IF(  IMAX.EQ.O. OR. JMAX.EQ.OI  GO  TO  280 

30  13 

c 

••*  define  constants  used  THROUGHOUT  CALCULATION. 

3010 

CYCLF.sNC 

30  1  5 

nuuspxo 

30  1  6 

.Vf  LAGF=  I  • 

30  17 

wFLAGL-0« 

3018 

NRZfNRt z-numrfz 

30  1  9 

TV.OP  (  =  2  .  «P  I  DY 

3020 

VT» 1 0. •• (-5) 

302  1 

S  S  2  =  I  • 

3022 

c 

•**  PRINT  YAUUF5  OF  MOST  INPUT  PARAMETERS. 

302  3 

/•  k  I  T  F  (  6 , 3  1  J  )  I  C  STOP  ,  I  EAT  X  ,  INTER  ,  I  M  A  X  .IPCYCL.IPR.IVArOX, 
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302** 

3025 

302A 

302? 

3029 

3029 

3030 

3031 

3032 

3033 
3039 
3035 
303  6 
3037 
3030 
3039 
3090 
30  9  I 
3092 
309  3 
3099 

3095 

3096 

3097 
3090 
3099 

3050 

3051 

3052 

3053 
3059 

3055 

3056 

3057 
3050 

3059 

3060 

306  I 

3062 

3063 
3069 

3065 

3066 

3067 
3060 

3069 

3070 

307  I 
30  7  2 
3073 
3079 
3075 
307  6 
30  7  7 


1  {VAROV.! J ,|2.JEXTV,JMaX.JPR0j,HaPS,MAK*, 

2  MAXT,MIMX,l1lNY,NADD,NDUMP7,NFReLP,NMXCLS. 

3  HOOUMP ,NS IDES ,NTCC .NTPMX  , N TR A CR . NUMHE Z , NUMSC A  » 

9  06 

«K| TE (6, 320)  BOAR ,C VIS tCVCMX .CYCPHJ ,0M t N ,DTM I N . 

1  OXF.OTF.EMtH, FINAL, GAMMA,  GLUED, PRCNT, 

2  PWnttT.PRFACT.PRUM.PADtUS.REZFCT, 

3  POOPS  ,  S5 7  ,  S  5 '(.,  S  7  AB  ,T570P  ,VT 

C  •  *«  PRINT  INITIAL  CONDITIONS 

WRJTF(6,3nD) 


00  30  L* 1  ,NMA  T 
HN  •  MAIIl-l 

WR I T£ ( 6 , 390 )  L .PHOZimN)  ,KHOIN(LI  ,SSIKM(L) ,UUR(L)  .VVAtLt 
7  H  CONTI HUE 

c  •••  Pf-lf'T  OX.OY  ARRAY'S  WHEN  THF  CELL  DIMENSIONS  ARE 

C  VARIABLE.  - 

IF  (  I VAPOA  .10.01  <50  TO  90 
WRITE  <6 . 330 ) 

WRITE  (6,350)  (  I  ,DX (  J )  , J  =  t  ,  IHAX ) 

Mil  IF  (  IVAPOY.FU.OJ  GO  TO  50 

WRITE  (6,3'lfll 

WRITE  (6,350)  (  J  ,(>Y  (  J)  ,  j*  I  ,  JMAX  ) 

&  LI  CONTINUE 

c  •»•  WHEN  t.gt.c.,  problem  Is  being  restarted. 

IF  (T.fcT.O.)  <30  TO  60 

C  •••  DEFINE  time  OF  FIRST  edit  PRINT  AFTER  CYCLE  ,0. 

PRTlMf.pROF.LT 
GO  TO  300 

C  PRpELT  »  0.  WHEN  PRINTING  ON  CYCLES  RATHER  TIME, 

6  0  IF  (PROELT.EO.C.  I  GO  TO  300 

f.  ...  QIFINE  time  OF  FIRST  FplT  PRINT  AFTER  RESTART  CYCLE. 

I W5» T /PROEL T *  I  . 

PRT  I  ME*=FLOAT  (  TV'S  )  .PKDELT 
GO  TO  300 

C  •••  READ  DUMP  TAPE 

7  fj  CONTINUE 

1  ws*o 

N M A  T - I  NT ( r« <  9  )  ♦  .  5  1 
PO  REV'  I  NO  KUNITR 
9C  READ  (KUMTP)  FR  It).  PR  (  2  I 

c  ...  FIRST  WO  R  o  OF  FIRST  RECORD  OF  EACH  DUMP  SHOULD  BE 

c  555.0.  Test  this  three  times  eeforf  exiting. 

IF  (PRC  1 >-556. Cl  100,110,100 
loo  t*V5«IVS+l 

IF  (M00(  I  MS , 3  I  I  220,220,60 
I  1 Q  IF  ( PR  (  2)  )  )  CC  ,  I  20 , 1 2C 

c  ...  WHEN  SETTING  UP  A  PROBLEM  PR(2)  ■  PK I  2  )  *  0.  WHEN 

c  Rt  starting  a  problem,  The  restart  Tape  is  read  until 

c  Pf (2) .GE.FK (2) •  THE  RESTART  CYCLE  NUMBER. 

170  IF  I PK ( 2 ) -FR ( ? ) )  15C.15C.I30 

130  NREC  «  NMAT.t? 

DO  190  L  c  2 .NREC 
|9  0  REAO  ( K  U  N 1 T  R I 
GO  TO  90 
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3078 

3079 

3080 
306  1 
3062 
3083 
306  9 
3065 
3006 
3ne7 
3088 
3069 
3090 

309  l 

3092 

3093 
3099 
3095 
30  9  8 

3097 

3098 

3099 

3100 

3101 
3  102 
3  1  G3 
3I01* 
3105 
3  1  C  6 
3  10  7 

310  8 
3  |  C  9 

3110 

3111 
3  112 
3113 
3  119 
3  115 
3  116 
3117 
3  118 
3119 
3  120 
3121 
3  122 
3  12  3 
3129 
3125 
3  128 
3127 
3123 
3129 
3  130 
3  13  1 


150  READ  IKUnITR)  (Z(  1  1  .  I»l  .  150) 

N  VC  1 0  ®  NMAT  ♦  I 

C  •*»  MAKE  SURE  PROBLEM  NUMBER  ON  TAPE  (PROP)  MATCHES 

C  PROBLEM  NUMBER  ON  INPUT  CARDS  tPKtl)  ). 

IMABS<PR0B-PK(  |  )  1  -  .Oil  151.151.210 

151  IF(PK(3I*3.)  160,152,180 

| 5  2  KUNITR=7 

160  READ  (KUN1TR)  ,  1  U  (  |  )  .  V  It  >  >  AKX  (  I  )  ,  A  I  X  <  I  )  i  PU),  MFLAG  <  I)  .  I  ■  *  iKMAv  ) 
READ  (KUNlTF)  (STRS2Z(1>»  STRSRRtl).  STRSRZCl).  1-l.KMAX) 

READ  (  K  UN  1  T  R  l  <X<I),  OMtl,  TAU<  1  )  ,  1  ■  1  ,  1  M  A  X  ) 

READ  (KUN1TR)  (Til),  oY(l),  I-l.JMAXI 

REAO  (KUN1TRI  (CZEROIM),  STKHM),  S  T  K  2  (  M  )  ,  S  T  E  Z  (  M  1  ,  RMU(h|, 

1  A  M  D  M ( M 1  t  RHOIN(M),  SSIEN(M),  UUR(M),  VVA(M),  MaT(M),  PLA|M», 

2  Mb  1  ,NMaT 1 

REAO  (KUN1 TR 1 (MPAC1 I ) ,MPACK1 I) * 1»1 ,M8BB) 

REAO  (KUNITR|((PACXn,L),PACT<l,Ll.t*l*M8f3BI.L«t,MBBI 
READ  (KUMTR)  (  (  XMASS  (  M  ,l  1  .  RHOIM.U),  SIE(M.L).  SAHPYIH.LI. 

1  SAMMP < M  ,L )  ,M® I  ,  NMA T >  ,RHO 1 NVO ID , L >  : , L *  1  . Nm X CLS I 

CO  165  N® l  i NVO  1  D 

REAO(KUNtTRl  NP,(TX(N,U  ,TT1N,L)  ,L«I  ,NP) 

NMR  ( N ) a  N  P 
1 65  CONTI NUE 

IE  1PK (3) .E9. C-3  »  >  50  TO  l 73 
REAOlKUNlTR)  NP ,  ( XP ( L )  .  TP  1 L )  ,  L® 1  ,  NP 1 

173  CONTINUE 

REAO  IKUMI1I  PR(1),  P  R  (  2  1 
C  *«•  PK(3)«-3.  FOR  A  -CLAM-  START 

C  CELL-CENTERED  TRACERS  ARE  not  GENERATED  nY  THE 

c  ■  «c lam*  generator* 

I  F  (  PK  (  3 J .EQ. t -3. 1  )  GO  TO  200 

C  •••  THE  FIRST  AORD  OF  THE  LAST  RECORD  OF  EACH  OUMP  SHOULD 

C  BE  555.0  OR  666.0* 

1  7  5  |FfPR(  1  1-555.0)  290,10,180 
180  IFCPR(2)-666.0)  253,10,250 

C  •••  INITIALIZE  i  ARRAY  AhF.N  lT  IS  READ  IN  FROM  CLAM  TAPE* 

200  00  205  I  ®  l  .  1 50 
205  Z  (  11 ®0, 

CAUL  CAROS 
CAUL  SETUP 
GO  TO  20 

c  problem  number  on  the  restart  tape  is  not  the  same  as 

C  THE  problem  NUMBER  ON  the  INPUT  CARD. 

2 l o  NK® l 50 

GO  TO  2 90 

C  •  CANNOT  FIND  FIRST  WORD  OF  FIRST  RECORD. 

2 20  NK  ®  100 

GO  TO  290 

C  .♦«  NOT  A  RESTART  AND  YET  Ztl>  ®  0. 

230  NK®S 

GO  TO  290 

C  FI9ST  *ORD  OF  LAST  RECOKO  IS  1NC0HRECT. 

290  NK=175 

GO  TO  290 

C  SECOND  Y  0  R  0  OF  LAST  RECORD  IS  INCORRECT. 
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•  ••  fMAX  OR  JMAX  IS  ZERO 


I 


3132  250  N<«iao 


3133  60  TO  290 

3139  C 

3135  2fi0  NK«36 

3136  290  NR« 1 

3137  C  •  *•  PRINT  FIRST  TWO  WORDS  OF  OUMP  fPRl  1  >  ,PR<2»  ) 

3138  C  AND  X { lb | 1 ,2 ( 1S2  1  i Z ( I  53  I  . 

3139  WR I T£ ( 6 , 360 1  PRU).  ZllSTl,  PR12),  ZI1S21,  ZI153) 

3190  CALL  ERROR 

3191  300  RETURN 

3)92  C 

3193  3 ( 0  F0RMAT(//7X,6H1CST0P,6X,6H  !EXTx,6T,6H  INTER, 6X,6h  IMAX.6X, 

3199  1  6H1PCTCL ,6X ,6H  I  PR  ,  6 X , 6 H 1 V  A RD X  .  6 X  ,  6h I  V  A RO T  ,  6 X  . 

31  95  2  6  H  ll.6X.6H  I2/1X.10I 12//7X, 

3(96  3  6  H  J£X  T  Y , 4  X , 6H  JMAX.6X.6H  JPR0J.6X.6H  KAPS.6X, 

31  9  7  9  AM  MAXX.6X.6H  MAXY.6X.6H  MinX,6X,6h  MINT  .  6  X  t 

3198  S  6 H  NADo .6X .6HN0UHP7/I X , I  01 1 2//7X  , 

3199  6  6MNFRELP, 6X .6HNMXCLS ,6X .6HN00UMP  ,6X ,6HNS I OES ,6X * 

3150  7  6 M  nTCC , 6X , 6H  NTPMX , 6X , AHNTRACR . 6X , 6HNUMREZ  ,  6X 

3151  9  6HNUMSC A , 6X , 6H  N 6 /  1  X  ,  1 0  1  1  2 / / ) 

3162  320  FORMAT ( //7X , AH  ,6X,6h  BBAR.6X.6H  CVIS.AX.6h  CYCMX.6X. 

3153  |  6HCYCPH3 , 6X »AH  0M1N.6X.6H  OTmIN.AX.Ah  0XF.6X. 

3159  2  6m  0TF.6X.6H  EM  1 N /  1  1  X  ,  I P9 E  1  2 . 9 / /  7X, 

3155  3  6 H  ,6X,6H  FINAL.6X.6M  GAMMA, AX, 6H  GLUED.6X. 

3156  9  6 H  PRCNT ,6X .6HPR0ELT ,6X .6MPRFACT ,6X ,6h  PRtlM.AX, 

3157  5  6hRA0|US.6X,6hREZFCT/1  IX,  1P9E12.9//  7X, 

3168  6  6  H  . 6  X  ,  6  H  R0EPS.6X.6H  SS2.AX.6H  SS9.6X. 

3159  7  6h  STAe.6X.6H  TSTOP.6X.6M  V T / I  1 X , 1 P 6 £  1 2 , 9 / / 1 

3160  330  FORMAT  »//7(3h  I  ,6X  ,  2H0R  ,7X1) 

3161  390  FORMAT  (//7(3H  J  ,  6 X  ,  2 HO Z  ,  7 X  I  1 

31  62  350  FORMAT  ( 7 < I  9 , 2 X , 1  PE  9 ... 3 , 3 X 11 

3163  360  FORMAT  (lHl.SX.72H***  CHECK  FIRST  RECORD  OF  ThE  DUMP  AND  FIRST  D,T 

3169  |A  CARO  OF  THE  INPUT  DECK  7  7  9X.7H0N  T APE . 9 1  X , 8H0N  CARDS  7  9X, 

3  ]  6  5  29H*S  «  ,F6. 1  ,9X  ,  7H  ISS5.0  J  ,29X  ,  8HZCIS1!  -  ,  F  8 . 9 , 3  X  ,  1  6H  (  PR  Ot!  LE  M  NUH*E 

3166  3R!  /  8H  CYCLE  -  ,  F 6 . 1  ,  9 X  ,  1 8H ( C T CLE  BEING  READ)  »13X,  8hZ<I62I  -F&*I. 

3167  96X.15H (RESTART  CTCLF)  7  37X, 

3168  5  1  2  X  .  0H2U53I  - , FS . I  , 6X , I 9H < REST  ART  FLAG!) 

3169  370  FORMAT  MI.7JS 

3170  1  ) 

3171  380  FORMAT 169H  PACKAGE  NORMAL  INITIAL  CONdIT 

3172  |  I  0  N  S  7  7  6  H  NUMBER  DENSITY  DENSITY  S.l.E* 

31  7  3  2  U  V/13X,  6  H I R  H  0  2 1 ■ 6  X »  7H(RhOINI/| 

3179  390  FORMAT(l5,Fj3.3,F13.3,VX,iPEl0.9,5X,lRE10.9,5X.lPE10.9) 

3175  END 

3176  SUflAOuTlNE  L OC I Jl X YL OC , LOC , F AC , I  DR  1 

3177  C  •••  GIVEN  CM.  COORDINATES  OF  A  POINT,  LOCIJ  TELLS  IN  *hICh 

3178  c  BOA  OR  column  OF  THE  GRID  THE  POINT  lS  LOCATED. 

3179  INCLUDE  COMCIM 

3160  C 

3 1 B I  C*******  F  A  C  B  0  •  AHEM  FINDING  TRACER  COEFFICIENTS. 

3182  C*»»*««»  FAC*. 5  WHEN  CALLED  FROM  SETUP. 

3 , p  3  £»»..»••  f A  c  *  I  *  When  finding  CELL  POINT  is  IN* 

3189  c« •*»•*•  I0K*0  AHEM  FINDING  AN  X  COORDINATE. 

3185  (••••••*  I  0Ra  l  *HEN  FINDING  A  t  coordinate. 
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118  4  C 

3187  !M IDR.EQ.OIGO  TO  9Q 

1188  C 

3189  C**»**<*  F  I  NO  A  Y  COORDINATE 


3190 

C 

•! 

3191 

00  10  LCO-  1 ,JHA* 

3192 

LOC-LCO  i 

3193 

YTEMP-Y (LOC-1 l*u .-FAC1 -DYILOCI 

319  9 

IFI  XYL0C*LT.YTtMP)60  TO  30 

3195 

10 

continue 

3  194 

C 

1 

3  197 

C* 

*  •  • 

•••  POINT  IS  OUTSIDE  GRID*  FIND  CELl  POINT  WOULD 

3198 

c» 

•  •  • 

•••  FALL  IN  IF  GRID  WOULD  BE  EXPANDED  UPWARDS. 

3199 

c 

3200 

0YTEMP».5* IdY ( JMAX ) ♦DY ( JHAX-1 n 

3201 

YTEMP»Y( jmax)-fac*dvtemp 

3202 

70 

LOC-LOC+1 

3203 

ytemp»ytemp*dytemp 

3209 

IF(XYlOC«6E.YTEMP1GO  TO  20 

3205 

30 

LOC-LOC- 1 

3204 

HETUR).' 

3207 

c 

3208 

c  • 

«  •  • 

•••FIND  AN  X  COORDINATE 

3209 

c 

, 

32  10 

90 

DO  50  LCO- 1  , 1  MAX 

321  l 

LOC-LCO 

3212 

XTEMP-X (LOC-I l+Il. -FAC )»0X< LOCI 

3213 

IF(XYLOC*LT»XTEMP)GO  TO  70 

3219 

60 

CONTINUE 

3215 

c 

3214 

o 

•••  POINT  IS  OUTSIDE  grid*  FIND  CELl  POINT  WOULD 

3217 

c- 

•  •  « 

•••  Fall  in  if  grid  woulo  be  expanded  tc  right. 

3218 

c 

3219 

DXTEhp-,5* ( DX 1  IHAXl+DXl I M  A  X - I > ) 

3720 

XTcMP-M  IrtAXl-F  AC-DXTEHP 

3221 

60 

LOC-LOC*! 

3222 

XTEMP«XTEHP*P7T FMP 

3223 

1  F  (  X  YlOC«(iE.XTFHP)  GO  TO  40 

3228 

70 

LOC-LOC”! 

3225 

RETURN 

3224 

end 

3227 

Subroutine,  map 

3228 

c 

•••  PRINTS  SYMBOLIC  GRAPHS  |AS  PART  OF  EDIT  PRINT)  OF 

3229 

c 

COVPPeSS10N.PRESURe.RAD! AL  VfLOC I TY ,  AX JAL  VELOCITY 

3230 

c 

ANf  INTERNAL  ENERGY  OF  CEILS  IN  THE  ACTIVE  GRID. 

3231 

INCLUDE  C0MD1M 

3232 

c 

3233 

c 

■  '  ;  "  •  • 

3239 

DIMENSION  W5MAX (5) 

3235 

DIMENSION  ALL (911 

3236 

DATA  ale/  2H  .|JH  -,2H  A,2H  B,*H  C,2H  D,2H  E.2H  F. 

3237 

1  2H  fi  ,2H  H,2H  I,2H  J,2h  K,2H  L,2H  M,2H  N.2H  0, 

3238 

2  7H  P,2H  Q.2M  K.2H  S,2h  T,2h  U , 2M  V,2h  A.2H  X* 

3239 

3  '  2H  r,2M  Z.7H  *,?H  •,2||  |,2H  2»?P  3.2H  9.2H  5. 
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32*10 

8  2H  6.2H  7  » 2H  B,2H  9,2H  Q,2H  / 

3  2*1 1 

DIMENSION  X(|M(8J  1 

3282 

OAT*  XUM/  7 H  .,2H  - . 2H-A » 2H-B , ?H-C , 

3283 

1  2H-G,2H-Hi2h-I.?M-J,2h-K,2M-I.i 

3288 

2  2H-P,2H-U.2H-R.2H-S,2h-T,2h-U, 

3285 

3  2H- V  .  2H-Z  . 2H-*  ,711-*  .  2H-1 . 2H-2  i 

3286 

8  2H-6 ,2H-7 t 2H-8 i 2H-9 *2h-0 ,2H  / 

3287 

MSYMBt»26 

3  2  8  8 

I  DC  *  M I  NO  1  1 1  .58) 

3289 

JOL  *  1  2 

3250 

iF  (NC.NE.O)  GO  TO  1 

3251 

IDL-MIHOI  1MAX  ,58  1 

3252 

JDL*JMAX 

3253 

C 

3258 

c 

•••  Finn  maximum  value  in  Active 

3255 

c 

3256 

c 

•••  COMPRESSION 

32S7 

1 

HV  S  M  I  N  »  1  0  E  2  0 

3258 

WSM A X  (  l  )«(). 

3269 

00  2  J« I  .  JOL 

3260 

00  2  I* 1  ,  IOL 

326  1 

K= l J- 1  1 • 1  MAX*  t ♦  1 

3262 

IF  1 ABS( A»X IK > > .lE.C.  >  GO  TO  2 

3263 

I F t MFLAGIK 1 .GT. 1001  GO  TO  2 

3268 

M  =  M  F  L  A  G  (  K  ) 

3265 

N  =  M  A  T ( M  | 

3266 

WSoRHOZINl 

3267 

IKIN.EQ.201  «S*t\MOlN(M> 

3268 

COMP*  AMX(K)/(OY(jl*TAU(  I  )»tvs> 

3269 

WSMAXIlt  =  AMAX I CWSMAXI  1  1  .COMF1 

3270 

ASM  I N  .  AMINI  (WSMIN.COMP) 

327  1 

2 

CONT I NUE 

32  72 

1  F  (  ttSMA  X  (  1  1  •  GT.V-SM  I  N  )  GO  TO  3 

3273 

VVSMtN  =  0. 

3278 

c 

•••  PRfSSNKE 

3275 

3 

W 5  M  A  X (21=0. 

3276 

00  8  Jo  1  . JOL 

3277 

DO  8  I =1 . I DL 

3278 

K» ( J- 1 1 • I  MAX* ! ♦ 1 

3279 

8 

CvSMA  X  (  2  )  «  AMAX1USMAXC2I  .ABS1PIIC)  )  ) 

3280 

C 

RADIAL  velocity 

328  1 

»SMaX(3)*0. 

3202 

00  6  J= 1 i JOL 

3283 

00  6  I o 1 . I DL 

3208 

K  *  (  J  -  l  1 • I M  A  X  *  I ♦ 1 

3235 

6 

WSMAX13I  •=  aMA*I  IWSMAXI3I  .ABSIU(K)  )  ) 

3286 

C 

•••  AXIAL  VELOCITY 

3287 

W  S  M  A  X  (  8  1  =  0  • 

3288 

DO  3  J= | > JOL 

3789 

DO  8  l = 1 i I OL 

3290 

K  =  I J- 1  ) • J  MAX* I  *  1 

329  1 

a 

.V  S  h  A  X  I  8  )  o  AMA/I  IVkSHAXlM)  ,-A8S«  VI*  »  )  1 

3292 

Vi  5  MAX (51=0. 

3293 

DO  10  J= l , JOL 
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329* 
3  295 

3296 

3297 

3298 
3799 
3300 

330  I 
3302 
3  30  3 
330* 
3305 
3  30  6 

3307 

3308 

3309 

3310 

331  1 
3312 
33  1  3 
33  1* 
3315 
33  16 
33  1  7 
33  19 
33  19 

3320 

3321 

3322 

3323 
332* 

3325 

3326 

3327 

3328 

3329 

3330 
333  1 
333  2 
3333 
333* 

3335 

3336 

3337 
33  38 
3339 

33*0 
33*1 
3  3*2 
33*3 
33** 
33*5 
33*6 
33*7 


c  •  ••  SPECIFIC  internal  energy 

po  10  I«l,lpL 
K»{ J-t > • I  MAX* !  +  1 

In  WSMaMS)  =  AMAX  1  (  WSMAX  (  6  1  ,  AHS  (  A  I  X  (  K  )  >  ) 

C 

r  •••  STOHE  INFORMATION  To  be  plotted  in  prop  array 

c  A  RCft  at  a  time. 

c 

NPROP  ■  1 

c  •••  COMPRESSION 

J  =  JOL 

MS=M5YMBL* 1  1 

IVR  l  TE  I  6  , 500  )  l 

Is  po  20  1*1 , IOL 
PHOPIpoO. 

K=( J-l )»1MAX*1*1 
IF  (  APS  (  AMX<K  >  »  .l-E.O.  )G0  TO  20 
IF (MFLAG (K I ,GT. 100)  GO  TO  20 
M«MI L  AG  IK) 

N=MAT(M) 

W  S  *  R  H  0  Z  I  N  ) 

1  F  |  H  .  EC)  ,  20  )  l‘.'S  =  RHO  1  N  <  M  ) 

PROP  I  I  »=aMX (K) / I TaUi I )*0Y ( J) *»S» 

20  CONTINUE  i 

GO  TO  1  10 
C 

c  pressure 

c 

30  J  =  JDL 

nS=mSYMBL 

IF (wSMAX  UIPROP)  ,LE.  0 • 1  GO  TO  396 
ft  R  t  T  E  (  6  ,  S  I  0  | 

3s  00  *0  I«  I  ,  1 01.  ! 

K=  (  J-  1  >  •  1MAX+T  +  I 
*n  PROP (  1  1  »  P ( K  1 
G  o  T  0  1  1  0 

c  -V 

c  RADIAL  VELOCITY 

C 

50  J  ■  J  I)  L 

.•  I F  (  W5MAX  I  NPROP  I  •  l_E »  0.1  GO  TO  3<?6  ! 

ftR I TE ( 6  , 520  I 

5S  00  60  I » 1 , lot 

K=( J-l I*1MAX*I*1 
60  PROP (11  -  U ( K ) 

GO  TO  I  1 0 
C 

C  AXIAL  VELOCITY 

c 

7  0  J  =  JOL 

IFOVSMAXINPROP!  ,LE.  0.)  GO  TO  39fc 
WRITE (A  ,530) 

75  DO  80  1 » 1 , I OL 

K= ( J- | 1 • I MAX+ I + 1 

•  '  I 


64 


339ft 

»0 

PROP! I )  ■  V1K) 

33*9 

GO  TO  110 

3350 

C 

3351 

c 

•••  SPECIFIC  INTERNAL  ENERGY 

3362 

c. 

3363 

90 

J*  JOL 

3351 

1  F  1  t.SHAX  1  NPPOF  1  •  LE  .  0.1  GO  TO  396 

3356 

92 

WR  l  TE ( 6  , 690 ) 

3356 

95 

no  ton  i=i • i oi 

3357 

K« ( J- 1  1 • 1  MAX* I ♦ 1 

3358 

ion 

PROP  1  1  1  =  A  I X { K  > 

3359 

c 

3360 

c 

**•  WHEN  PRINTING  FIRST  (TOp)  R«W  OF  MAP.  COMPUTE 

336  1 

c 

SCALE  FACTOR  AND  PRINT  K FT. 

3362 

1  1C 

lFIJ.LT.JOL)  r,0  TO  300 

3363 

c 

3369 

c 

3365 

c 

*••  COMPUTE  SCALE  FACTOR  AND  PRINT  MAXIMUM  VALUE  OF 

3366 

c 

Each  symbol  used 

3367 

c 

3368 

1  80 

SCALE  »  WSMaX (NP60P) /FlOAT(MS) 

3369 

tFlNPROP.EU.il  SCALE*  (t.SN  AX  <  1  )-l»SM|N) /FLOAT  (MSI 

3370 

IF  ( ( A  !  NT  I SCAI  1  • 1  POO . 1 1 .L T . (SCALE* |CCO» 1  I  GO  TO  190 

337  1 

GO  TO  200 

3372 

1 9n 

SCALE  =  A  1  NT  1  SCALE* 1 000,* 1  » / 1000, 

3373 

2oa 

CONTINUE 

3379 

c 

3375 

JFlNPR0P.t9.il  GO  To  220 

3376 

VALUE (11  a  0. 

3377 

VALUF12)  =  SCALC/lC, 

3378 

VALUE2»VxLUr 1 7 ) 

3379 

DO  210  1*1, MS 

3360 

2in 

VALUE (1*2)  *  FL0AT(1)*SCALE 

338  1 

GO  TO  290 

3382 

c 

*••  VALUES  f OH  COMPRESSION  MAP 

33  63 

221) 

VALUE!  1)  =■  ASM  t  N 

3  38  9 

00  230  l»t .MS 

3365 

230 

VALUE!  1*1  1  a  FLOAT  1 I) *SCALE  ♦  WSHIN 

3386 

C 

•••  PRINT  DEFINITIONS  OF  MAP  SYMBOLS 

3387 

290 

I  L  I  M  1  «  1 

3368 

1  L  1  II  2  -  10 

3389 

HSpsMSYfiBL  ♦  .? 

3390 

250 

IF  (MSP.LT.IL1M?)  1  L  I  M  2  »  MSP 

339  1 

IF  (NPR0P.NE.1I  GO  TO  2GC 

3392 

WRITE (6,550)  (ALEin.IalLIMt.ILI  M2) 

3393 

Y,R  I  TE  (  6 ,560  1  (  VALUE  (I  1  ,  |  =  IL  IM1  ,  !L  IM?I 

3399 

GO  TO  2  7 U 

3395 

260 

IV  RITE  (6, 57  0)  (AlE(l),I«lLIMl,ILIM2) 

3  3  96 

,<H  1  TE  I  6 ,580)  (VALUE(1),I'IUIM1,1LIM2) 

3397 

270 

ir  (NSP.EO.UIM?)  Up  To  280 

3398 

f L (K J  a IL IM2  +  I 

3  3  S  9 

IL1H2«ilIm2*IC 

39C  C! 

GO  TO  250 

390  1 

7  60 

(r.R(TE(6,590) 
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3*C2 
3903 
3  9119 

3905 

3906 
3  9  0  7 
3900 
3909 
39  10 
39  I  1 

39  1  2 
39  I  3 

39  J  9 
3915 
39  1  6 
39  17 
39  1  8 

3919 

3920 

3921 

3922 

3923 
3929 
3925 
3928 

3927 

3928 

3929 

3930 

3931 

3932 

3933 
3939 
39  35 

3934 
3937 
3  “  38 
3939 
3990 
399  1 

3992 

3993 
3999 
3995 

3994 

3997 

3998 

3999 
3950 
395  1 
3952 
3«53 
3959 
3  9  S  5 


C 

c  AS5I6N  APPROPRIATE  SyMfloL  TO  EACH  CELL  IN  ROW  J, 

C 

300  00  370  !»l . It-L 

K»t J-l I«IHAX*|*1 

IF  (  AMX  (K  )  •GT.O  .  )  CIO  TO  3  1  0  ’ 

HA  «  91 
00  TO  340 

310  IFlhPR0H.CQ.il  GO  To  390 

1 F < APS  I  PROP (  I  I  1 . GT.Q. I  GO  TO  320 
M  A  ■  | 

GO  TO  360 

320  |F( ABSIPROPl 1 > I .GT.VALUE2)  GO  TO  330 
MA  =  2 

GO  TO  360 

330  FLCTHA  *  ABSIPROPl 1 ) ) /SCAl E  +  2. 

HA  «  INTIFLOTMAl 

1FIFL0TMA.GT.AIHT (  F  L  0  T  M  a  1 )  MA»MA*1 
MAaMAxOIMA,3> 

GO  TO  360 

C  DEFINE'  Ha  FOR  COMPRESSION  MAP 

390  IF(MFLAGIK)  .1  T.  10Q)  GO  TO  395 
M  A  *  30 
GO  TO  360 

395  IF  (PROP!  I  )«GT«T<SMIN)  GO  TO  350 
M  A  ”  I 

GO  TO  360 

350  FLUTMa  =  ABS ( PROP  1 l ) -H SM l N > / SC  ALE ♦  1  . 

HA  •  INTIFLOTMAl 

IF ( FLOTMA.ST. A INT (FlOTMA 1)  HA  *  MA.l 
MA  a  MAXO ( MA ,2 1 

C  ...  STORE  CHARACTER  TO  bE  PLOTTED  FOR  CELL  K 

360  PR (  1  )  •  ALE ( HA  I 

1F(PR0P(II»LT.C.)  PR(I)  «  XUH1MA1 
C  ...  ENO  OF  I —LOOP 

370  CONTINUE 

C  »«•  PRINT  J  RO#  OF  H  A  P 

I F ( MOD ( J . 5 > . NF • 0  )  GO  TO  3H0 
AtR  I  TE  (  6 ,600  1  J  i  I  PR  (  1)  i  I  =  1  ,  IDL  ) 

GO  TO  390 

380  ftRlTEI6,6IOI  (PRIII,  lat.IOLl 
390  J=J-I 

C  •••  HAVE  *E  REICEl)  BOTTOM  Hr* 

IFIJ.ECj.OI  GO  Tn  395 

GO  TO  ( 1 S , 35, 55 , 75 , 95 1 . NPROP 

c  ...  print  anli  label  x-axis  of  «ap 

395  PRIII  =  ALE (29) 

AR  l  T  E  (  6 ,6C0  1  .1,  (  PR  I  I  )  ,  1  =  l  ,  1  DL  ) 

*KITF(6,62U)  (I,  1*2,11)1,51 

C 

396  NPROP  a  NPROP.I  [ 

GO  TO  (900,30.50,70,90.900)  .HPROP 

C 

9on  return 
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3456 

C 

««•  FORMATS 

3457 

soo 

FORMAT! 1H1 , 4 X  ,  1 5HCUMP RESS I  ON  //) 

3458 

5 1  0 

FORMAT! 1H1 ,4X, 15HPHFSSURE  //> 

3459 

520 

FORMAT  1  1HI  ,4X , 15HRAD1 AL  VELOCITY//! 

3  4  60 

530 

FORMAT! 1MI  ,  4X  ,  1 SHAX JAL  VELOCITY  //) 

346  t 

5  40 

FORMAT!  IH1  ,4X»24MSPEC1FIC  INTERNAL  eNF.RGT//) 

3462 

550 

F0RMAT(15i|  SYMBOL  1  10  (  4X  ,  A2 ,4X  1  1 

3463 

560 

FORMAT!  16H  MAXIMUM  VALUE  ,10<F6.3,4X>) 

3464 

57C 

F0RMAT(|6H  SYMBOL  ,  10! 3X»A2,5X) ) 

3465 

580 

FORMAT (  16H  MAXIMUM  value  ,  l  P  1  OE 1 0 • 2 ! 

3466 

590 

FORMAT (// ) 

3467 

600 

FORMAT! I IQ,2H  l,64A2) 

34  68 

610 

FORMAT! 1 UX ,2H  !,54A2) 

3469 

520 

FORMAT! 112,101 10////! 

3470 

END 

347  1 

end 

3472 

SU8R0I/T  I  WE  NF1VHIX 

FOR  A  CELL  THAT 

3473 

C 

•  ••  SETS  UP  STOKaOC  IN  M 1 X  E  n  CELL  ARRAYS 

3474 

c 

MAS  JUST  BECOME  MIXEOMWhOSE  POUNDARY 

HAS  JUST  oEEN  Ci)T 

34  75 

c 

PY  AN  INTERFACE).  CALLED  FROM  INFACE 

• 

34  76 

INCLUDE  COMOIM 

3477 

c 

CFLL  K  HAS  BECOME  MIXCD,  SEARCH  FOR 

3478 

c 

AVAILABLE  STORAGE  LOCATION  IN  MIXED  ARRAYS 

3479 

00  620  M=\l  ,NMXCLS 

3480 

|F(rhO(  1  ,m!.LT.C.  )  <50  TO  <>3D 

348  1 

620 

CONTINUE 

3482 

C 

IF  YOU  FALL  THROUGH,  THERE  is  no  available 

3463 

C 

STORAGE.  PRINT  MESSAGE,  CALL  EXIT, 

3484 

6  R I T  E ( 6 ,  1000)  I  ,  J,  K 

I  I ,J,K)»,4l6) 

3485 

l  non 

FORMAT ( 46HIRAN  OUT  OF  STORAGE  FOR  MI*ED  CELLS, 

3486 

N K>  |  0 

3487 

NK  =  6  20 

3488 

call  error 

indicate 

3489 

c 

•••  REDEFINE  HFLAG.  RHOCl.H)  .GL.  0.  WILL 

3490 

c 

M  STORAGE  IS  BEING  USED. 

349  1 

630 

CONTI NUE 

3492 

IFIRHOl 1 <M) «GE*“I * )  GO  TO  635 

3493 

N  R  =  1  0 

3494 

NK=630 

3495 

call  error 

3496 

6  35 

MFl.  AG  IK)  “M*  I  00 

3497 

1)0  640  NN=!  ,NMAT 

3498 

RHO!NN,H)*0. 

3499 

XMASS(NN.M) =C. 

3500 

SI L 1 NN,M)=0. 

3501 

640 

CONTINUE 

3502 

IF(MO.EQ.O)  GO  TO  7CG 

3603 

HHOIMO.M)  “  AHX ( K ) / ( TAU < 1 ) «0Y < J ) ) 

3  5  0  4 

XMAS5(M0,H)bAMX (K ) 

3505 

S  I  t  <  MO ,M ) *  A  I X  I K ) 

3606 

C 

MAKF  UP  SURCTCLFS  IF  NEfFSSARY 

35  07 

1FICYC.LT. 1.)  GO  TO  700 

3508 

c 

DEFINE  FRACTP.  FRaCRT  SO  FLUX  VAR]ABlfS 

35  0  9 

c 

CAN  F;  E  DEFINED  FOR  SUPCVCLES  ALREADY 

completed. 
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3510  FNacTP(mO,M)  ■  TaU<1I 

35H  FRACRT(mO.M)  ■  DY ( J  I  • X ( I  )  «TW0Pl 

3512  IF ( 1GH.EW* 1 IFPACfiT  <M0,HI«0Y(JI 

3513  C  •••  STORE  FLAGS  OF  CELL  ABOVE  AND  CELL  ON  RIGHT. 

3519  KA«K*IMaX 

3515  K  R K ♦ 1 

3516  MA=IABS(MFLAG(KA I  I 

3517  MR«IAB5IMFLAG(KP1I 

351B  CALL  FLUX 

35 l*  FHACTp(M0,H)3C. 

3520  FHACRT(MO,M)«0. 

3521  700  H«=M.loo 

3,522  RETURN  ....  .. 

3523  END 

35  2  9  SUBROUTINE  NEY'PHO 

3525  C  «♦«  PEFINFS  THF  Of  NS  I T Y  OF  a  MATERIAL  WHOSE  INTERFACE 

3526  C  HAS  JUS T  ENTERED  CELL  K.  (CALLED  FROM  INFACE.) 

352  7  I NCLUpt  CCNo  J  H 

352B  EQUIVALENCE  (‘"EV.RTy),  (».'SX,TPX),  («SC,FRACX) 

3529  C 

3530  C 

3531  C  •••  IS  POINT  ON  RIGHT  OR  TOP  BOUNDARY  OF  CELL  K* 

3532  C 

3533  IF ( FRACX.GT.O.  )  GO  TO  100 

3  5  3  9  C 

3635  C... ............  right  BOUNDARY.  CONSIDER  CELL  ON  RIGHT  FIRST. 

3536  C 

3537  KT«K* | 

3  5  3  B  I  T  •  i  .  j 

3539  jT  ej 

3590  I M  I T , g T  •  J  M  A  X  |  GO  To  20 

3591  5  HT=tAtiS(MFLAG(KTT) 

3592  IF (MT.EO.C)  GO  To  20  1 

3593  C  IS  CELL  NT  MIXED  OR  PURp, 

3599  IF (MT.LT . 100 >  GO  TO  10 

3595  c  •  mixed,  does  it  contain  material  n. 

3596  IF  (  RH0(N,F*T-1C0)  .LE.O.  1  GO  TO  20 

3597  C  YES.  USE  ITS  DENSITY. 

3598  MT=HT-!00 

3599  GO  TO  220 

3550  C  PURE.  DOES  IT  CONTAIN  MATERIAL  N. 

3551  10  IF(MT,EQ.M  GO  To  730 

3552  C 

3563  C  ...  CELL  NT  DOES  NOT  CONTAIN  MATERIAL;  N . 

3559  C  CONSIDER  ANOTHER  NEIGHBOR  CELL, 

3555  20  IF  UT.EQ.KM  )  C.O  TO  3D 

3566  IFIKT.EQ.K-IKAX  .OR.  K T  .  1 6  .  K+ 1 h AX  I  60  TO  50 

3567  C  ...  NONE  OF  THE  NEIGHBOR  CELLS  CONTAIN  MATERIAL  N 

355B  C  --  CALL  ERROR  THEN  EXIT 

3559  NK*20 

3560  nR«!I 

3561  CALL  ERROR 

3562  C  •»•  CEIL  ON  RIGHT  00£S  NOT  CONTAIN  MATERIAL  N. 

3563  C  CONSIDER  CELL  B  E  L  O  A  OR  ABOVE  DEPENDING  ON  WHICH 
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356** 

c 

THE  INTERCEPT  IS  CLOSER  TO. 

3565 

30 

IFIRTv-aINT(RTT)  .LT.  liSII  SO  TO  **0 

3566 

c 

•  *♦  USE  CELL  ABOVE 

3567 

KT*K* I MAX 

3568 

I  T  ■  | 

3569 

JT»J*1 

3570 

- 

IFljT.GT.jMAX)  GO  To  2Ci 

357  1 

GO  TO  S 

3572 

c 

USE  CELL  BELOfc 

3S73 

**0 

KT*K-IMaX 

357** 

1  T»I 

3575 

jT=jT-| 

3576 

IEUT.lt.  1  1  60  TO  20 

3577 

GO  TO  5 

3578 

c 

•••  CELL  AbOVE  OR  BELOft  DOE*  NOT  CONTAIN  MATERIAL  N» 

3579 

c 

consider  diagonal  CELL. 

3560 

50 

KT.kT+1 

358  1 

I  T  =  I  *  I 

3562 

|E  <  I T . GT • 1  max )  GO  TO  20 

35  B  3 

<7* 

O 

- 4 

o 

IT 

3  5  B  *» 

c 

3585 

c< 

FIRST. 

3566 

c 

3587 

ICO 

KT*K* IMaX 

3588 

I  T  *  I 

3569 

JT*J+1 

3590 

I r < jt.gt. jmaxi  go  to  120 

359) 

1  05 

MT*IABS<MELA6(KT) 1 

3692 

IF  1MT.FQ.01  GO  TO  1 20 

3593. 

c 

*••  rS  CELL  XT  MIXED  OR  PURE. 

359** 

IF  C  MT . LT. 1  DO)  60  TO  1  1 0 

3595 

c 

MIXEC.  DOES  IT  CONTAIN  MATERIAL  N. 

3596 

IFIRHOlN.MT-ICCl.LE.O.)  60  TO  120 

3597 

c 

•*«  YES.  USE  ITS  DENSITY, 

3598 

MT»mT-  1 00 

3599 

GO  TO  220 

3600 

c 

•••  pupe.  odes  it  contain  material  n. 

360  1 

1  1  0 

IMMT.fQ.tJl  60  TO  230 

3602 

c 

•••  CELL  XT  does  hot  contain  MATERIAL 

N.  CONSIDER 

3603 

c 

ANOTHER  NEIGHBOR  CELL 

360** 

120 

1EIKT.EQ. *<+!*' AX)  GO  TO  130 

3605 

IF! KT.EC.K* I ,0R. KT.FG.K-1 >  GO  TO  150 

3606 

c 

•  ••  HO  NEIGHBOR  CELL  can  GIVE  DENSITY 

V  A l_OE  •  THERE  MUST 

3607 

c 

EE  AN  E' R R  0 R  . 

3608 

N  X  =  1  2  0 

3609 

nr*i  i 

3610 

CALL  ERROR 

36  1  1 

c 

CELL  ABOVE  DDES  NOT  CONTAIN  MATERIAL  N.  CONSIDER 

36  1  2 

( 

CELL  ON  RIGHT  OR  LEFT  DEPENDING  ON 

6  H 1 C  H  THE  INTERCEPT 

36  1  3 

c 

IS  CLOSER  TO. 

36  1  ** 

1  Ml 

!F1  TPX-AlHT  1  TPX  1  .LT.  1.51)  GO  TO  1**0 

36  15 

c 

USE  C  ELL  ON  R I GhT 

36  16 

KT»K» 1 

36  17 

I  T  =  I  +  | 
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J’mJ 

If  UT.GflMAX)  GO  To  120 
GO  TO  105 

•••  USE  CELL  ON  LEFT 

kt»k-i 
I  T  «  I  -  1 

JTkJ 

IfllT.LT.il  60  TO  120 

GO  TO  105  ; 

CELL  ON  RIGHT  OR  LEFT  DOES  NOT  CONTAIN  MaTE«1aL  N. 
consider  diagonal  CELL. 

KT=kT*ImAX 

JT*  J+  1  i 

!F( JT.GT.JHAX)  GO  To  120 
GO  TO  IDS 

CELL  KT  15  MIXED  AND  CONTAINS  MATERIAL  N. 

RHO l N ,M )  =  RHO I N ,MT 1  i 

GO  TO  300 

*•*  CELL  XT  IS  PURE  AND  CONTAINS  MATERIAL  N 

PHOIM.Ml  •  AMT < XT  1 / ! T AU (  1 T 1 *0Y t JT )  )  1 

RETURN 

END 

SUuKOuTINF  PHI 

COMPUTES  EFFECTS  OF  PRESSUPE  TERMS  TO  OPoaTE  CELL 
VELOCITIES  and  INTERNAL  FNEPGT.  ! 

INCLUDE  COMpIM 


•••  NR  T  AND  NKC  ARC  USED  TO  ADVANCE  THF  ACTIVE  GRID. 

N  R  T  o  0 
N  R  C  *  0 

VEL'l.  FLAGS  FIRST  PASS.  ON  SECOND  PASS,  VEL  -  0. 

vtL» 1.0 

•••  RC  *  DISTANCE  FROM  AXIS  TO  CENTER  OF  CELL  <• 

RR  ■  DISTANCE  FROM  AXIS  TO  CENTER  OF  CELL  K*l. 

RC-rX  (  1 

RReRC*  I  0X(  1  | +F;>.  (  2  1  ) /2 .0 
1  F  (  1  GM  •  E Q  .  1  I  R’C«  1  . 

IF (  1  G  M  »  E  0 • I  (PP*PC 


FOR  ALL  CELLS  IN  COLUMN  NEXT  To  AXIS,*  SET  PRESSURE 
AT  LEFT  SIDE  OF  CELL  «  PRESSURE  IN  CELL,  aND  SET 
RADIAL  VELOCITY  AT  LEFT  SIDE  C'p  CELL  =  0. 

DO  20  J= 1  , JMA  X 

PL ( J 1 sP ( K  1  ! 

ULIJI*0.0 
x  =f ♦ I r a  x 


3672 

DO  190  I«1  ill 

3673 

K  ■  I  *  1 

3679 

C 

*♦•  define  pressure  and  ax:4l  velocity  at  bottom 

3675 

C 

BOUNDARY  OF  GRID. 

3676 

V  B  L  0»  V ( K  » 

3677 

PIiLO»P(K) 

3678 

c 

•**  IF  FQTTOm  BOUNDARY  Of  GRID  IS  REELCCT1VE,  SET 

3679 

c 

AXIAL  velocity  at  that  boundary  -  0. 

36B0 

IF  < CV 1 S«GT. ( -.5  I )  V8L0«0. 

368  1 

TAUDTS=T AU 1 I 1 *0T 

3682 

00  13(]  JM.I2 

3683 

N»K  +  I  MAX 

3  68  9 

PIDTS*l.G/«PlriT*OT»DY(jn 

3685 

IF(  lGM.EC;.  1  MJlDTS"2./«0Y(J»*DT) 

3686 

IF  < AMX ( K > -LE . C» )  GO  TO  3C 

3687 

IF  (l.t-T.)HAXl  GO  TO  50 

3688 

c 

•  F  OK  ALL  CELLS  IN  LAST  COLUMN  OF  GRID.  SET  PRESSURE 

3689 

f 

AT  RIGHT  OF  CELL  •  PRESSURE  IN  CELL.  COMPUTE 

3  6  9  0 

c 

energy  lost  across  right  boundary  and  subtract  it 

3691 

c 

from  e th,  theoretical  energy  total. 

3692 

PKRePIK I 

3693 

E*FKR»LI|K)/EIDTS«RC 

3699 

ETHsETM-E 

3695 

EOR=EOR*E 

3696 

GO  TO  HO 

3697 

c 

•••  CELL  K  IS  EMPTY 

3699 

3n 

PL  <  J ) «n . 

3699 

UL 1 J I «U  <  K ♦ 1  I  »PR 

3700 

P  B  L  0  *  0  • 

3  7  0  1 

V  B  L  0  =  V ( H 1 

3  702 

.  GO  TO  130 

3703 

80 

URR  =  RC*U  <  K  ) 

3  7  U  9 

GO  TO  70 

3  705 

C 

•••  IE  CELL  ON  RIGHT  Is  EMPTY  SET  SPECIAL  P  AND  U 

3706 

50 

IE  < AHX IK* I > .GT.O. )  GO  TO  60 

3707 

pRK=n . 

3709 

URR=U(K)»RC 

3709 

GO  TO  70 

37  10 

60 

PRRe l P ( K I *P ( K*  U  1 /2 , 

371  1 

UPR» ( U ( K ) «RC*U 1 K* 1 ) *RR 1 /2. 

3712 

70 

;f  ij.lt.jmax)  go  to  bo 

37  13 

c 

«*»  FOR  ALL  CELLS  IN  TOP  ROv,  OF  GRID.  SET  FRfSSURE  AND 

37  19 

c 

AXIAL  VtlOCITY  AT  TOP  OF  CELL  ■PRESSURE  AND  AXIAL 

3715 

c 

VELOCITY  JN  CELL.  COMPUTE  ENERGY  LOST  ACROSS  TOP 

37  16 

c 

BOUNDARY  . 

37  1  7 

PAI)0Ve  =  P1N) 

3718 

E*PAB0VE»V(K)/2.*TA0r<TS 

3719 

ETH=ETH-E 

3720 

EOT=EOT*E 

3721 

VAOOVE=V(K) 

3722 

GO  TO  1)0 

3723 

c 

».«  IF  CELL  ABOVE  IS  EMPTY  SET  SPECIAL  P  AMU  V 

3729 

80 

IF  (AMX(N).GT.C.)  GO  Tv  90 

37  25 

p  A  B  (J  V  e  =  0  . 
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37  26 

VABOVE«V(K» 

3727 

60  TO  100 

3  7  2  8 

90 

PAROVE»(P«M*P«NI  >/2. 

3729 

VABOVe»(V«K)*VCM )/2, 

3730 

100 

IP  (J. ST. 1  1  GO  TO  1  10 

37  3  1 

c 

•••  WHEN  bottom  BOUNDARY  T R a  NS M I T T i v e  (CV1S--1.I,  COMPUTE 

3732 

c 

ENERGY  lost  ACROSS  BOTTOM  BOUNDARY  and  SUBTRACT 

3733 

c 

IT  FROM  'CTh*.  THCORECTICAL  ENERGY  TOTAL. 

37  39 

c 

SKIP  OUT  IF  BOTTOM  BOUNDARY  REFLECTIVE  ICVJS«0.I  . 

3735 

IP  ICVIS.6T.-.5)  GO  TO  110 

3736 

E=PHLO»V ( K ) /2. »TAUOTS  ! 

37  37 

ETHaETH  +  F. 

37  38 

eob*eob-e  1 

37  39 

l  10 

IF  (VEL.EO.nO  GO  TO  120 

3790 

c 

COMPUTE  UPDATED  VELOCITIES  ON  FIRST  PASS  < VfcL  «  t.) 

378  1 

V  (  K  >*V  (K  I  ♦  (Pfll.O-PABOVC  >  •TaUOTS/  |  A  MX  IK  )  ) 

37  92 

U(K)»U(K)*(Pl.  (J)-PRR»/(AHX(K))*RC/PIDTS«2.0' 

379  3 

1  20 

CONT I NUE 

3799 

c 

0 N  FIRST  PASS  ONE  HALF  THE  NEW  AlX(K)  IS  CALCULATED 

3  7  95 

t 

using  gradients  based  on  old  velocities,  on  second 

3796 

c 

PASS  the  other  half  OF  THE  NEW  a  I  X  ( K )  IS  CALCULATED 

3797 

c 

USING  GRADIENTS  BASED  ON  hew  VOLOCtTlES.  note.  SOME 

3  7  9  B 

c 

CELLS  ARE  'GLUED*  AFTER  SECOND  PASS  TO  CORRECT 

3799 

c 

HIGH  NEGATIVE  INTERNAL  ENERGIES. 

3750 

WS=(VBLO“VAfiOVE>*TAUDTS/2. 

375  1 

WS*<UL<J)-UHf!l/P|OTS  +  WS 

3752 

WSA  «  WS*P  I  K  I 

3753 

AlX(K}aAIX(KI*6SA/AMX(Kl 

3759 

c 

i 

3755. 

MFK*MELAG(K) 

3756 

c 

•••  IS  cell  k  PURE 

3757 

IFIHFK.LT. 100)  GO  TO  129  : 

3758 

c 

CFl.l  K  MIXED.  PARTITION  CHAN6E  JN  INTERNAL  ENERGY 

3759 

c 

IN  PROPORTION  TO  FRACTIONAL  VOLUME. 

3760 

m»mek-iou 

376  1 

c 

•••  IF  CELL  CONTAINS  A  free  SURFACE.'  DEFINE  TOTAL  VOLUME 

37b2 

c 

(VCELL)  TO  BE  SUM  OF  VOLUMES  Of  MATERIALS  IN  CELL. 

3763 

VCELLaO. 

3769 

DO  119  N* 1 .NMaT 

3765 

IFlRHOlN.Ml .LE.C. I  GO  10  119 

3  7  66 

VCELL a VCELL* XM ASS  1 U ,M> /RnOtN ,M) 

3767 

1  1  9 

CONTINUE 

3768 

c 

3769 

12  1 

00  122  tl»  1  .  N H A  T 

3770 

I  F ( XMASS ( M «M » ,LE .0. )  GO  TO  122 

377  1 

ttS  a  XMASS 1 N i M ) /RHO t M , M ) 

3772 

WSaWS/VCELL  i 

3773 

c 

»•»  change  in  internal  energy  for  material  n. 

3  7  79 

Vi  5  a  =  .  V  S  A  *  *  S 

3775 

Slt(N.M)  =  5 [ E  <  N i M  >  +  MS6/XMASS(N,M) 

3776 

122 

COl.T  INUE 

3777 

129 

CONTINUE 

3  7  7  8 

VBt.OaV  ABOVE 

3779 

PLIJIaPRR 
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3780 
378  1 
3782 
376  3 
378** 
378ft 

3786 

3787 
3768 

3789 

3790 

3791 

3792 

3793 
3798 
3  7  8  ft 
3  7  96 

3797 

3798 

3799 

3800 
3  8  0  1 

3802 

3803 
3809 
3  8  0ft 

3806 

3807 
380  8 

3809 

3810 
36  l  1 
3812 
38  13 
38  1  9 
381ft 
38  1  6 
38  17 
38  1  8 
38  19 
3820 

382  1 
3  87? 
3823 
3829 
307ft 

3826 

3827 

3828 

3829 
3  8  3  0 

383  1 
3832 
3 .3  3  3 


llL  1  J  1  »UR8 

polo«pabove 

C  RC,  Ml  HR  REDEFINED  FOR  NEXT  CELL  IN  ROW  J. 

130  K*K*IMAX 
RC-RR 

RR* ( X  1  1*1 >*X<  1  +  21 1/2. 

1  F  I  1  GM.E  Cl.  1  )  PC  =  !  . 

I F (  1 6  M . E  Q • 1  >  R  R  =  R  C 
(90  CONTINUE 

IF { VFL.EU.O.  I  60  TO  191 
VEl *0  •  0 
GO  TO  in 

191  CONTINUE 

c 

Y.S=0. 

1)0  I  9 l 9  K= 1  , r MA  X 

M  »  N  F  C  A  6  <  K  ) 

IFIH.GT.1C0I  r,0  TO  18  12 
M  S  »  A  M  A  X  ]  U-S,  A  1  X  t  K  1  > 

GO  TO  1919 

1912  |I  =  M-IOO 

1)0  19  13  N«l  ,flU/.T 
W S *  A M A  X  1  IN S , ft  T  f 1 N  ,  M  )  1 

1913  CONTINUE 
1919  CONTINUE 

R5=S0RT(W5) 

U  V  R  A  X  =  A  M  A  X  1  O'ft.UVNAXI 
00  192  1=1.11 
00  192  J=l,l? 

K=( J-l )»IHaX«I+1 

1  F  t  AftSlUO;  1  )  .f.T.llVHAX  .OR.  ABS  (  V  <  K  )  )  •  GT  .  0  VM  A  X  >  PF  L  A  G  (  K  >  »“HF  L  *6  <  X  1 

192  CONTINUE 

C  ...  GLUT  SPECIAL  CELLS  TO  CORRECT  FOR  UNREALISTIC  VELOCITIES 

CALL  GLUE 
DO  190  1=1.11 

K  =  I  +  1 

00  160  J= I . [ 2 

170  IF  (  I . N  E • 1 i  )  GO  TL  ICC 

C  •••  ENLARGE  active.  hRID  IN  |  »0 1 KF  CT 1  ON  IF  A  CLLL  IN  TEiE  II 

C  CNI  UHf  HAS  N(lN2f.R0  VFLOt  I  T  T  OF  ENERGY. 

IK  (UIKl.NE'  ,D..0R«Vck).NE»C..0R.A!X()1.NE.0«)  N  R  C  *  1 
l  8  [)  K  a  N  ♦  1  M  A  X 

LL=K -2 • I NAa 

c  ...  e;!J|  AUGE  ACTIVE  OHIO  IN  J-N 1 1  E  CT 1 CN  1  F  A  CLl.L  IN  T  ML  12 

C  ROT  ll»S  NONZtFO  VELOCITY  OR  ENERGY. 

IE  (U(LL>.N£-0*.Of;.V(LL).NE*0*.0R.AlXtLl-).NF.0.)  NRT«1 
190  CONTINUE 
I  1  =  1  1  ■»  N  R  C 
12=1 2  +  N  R  T 

c;  ...  nOf-1  /;  1  I  m  f  ’  J  \  1  GRID  TO  EXCEED  1  *"  A X  I-  Y  JHAX  &R1U. 

[  E  (  [  I  -  [  :l  aA  )  2  10.210,  ?UC 

200  |1  =  IN,-.A 

210  IE  (12-J0AX)  2JI1.2  30.22C 

270  I  2  “  J  ’1 A  X 


73 


i 


3839 

<?3Q 

RETURN 

3  8  3S 

C 

! 

3836 

290 

FORMAT  (  911  PHI, 219, 9M  M=  ,  1  PE  1 5 . 8 , 6H  S  1  E  ■  ,  1  PE  1  5  .  6  ,  9H  Ua,|PEl5.B 

3837 

9H  V=  ,  |  PE  1  5  •  P  ,  !  6H  SIE  OF.  T  TO  ZERO) 

3838 

END 

3839 

SUBROUTINE  PH? 

3890 

C 

ACCOUNTS  for  mass  flux  and  ASSOCIATED  TRANSPORTS  Op 

309  1 

C 

MOMENTUM  AND  ENERGY. 

3892 

include  comdim  ! 

3893 

0! HENS  ION  SYHHOLIB) 

3899 

OATA  SYMB0L/2H  1,2H  2 , 2m  3,2h  H,?h  S,2H  ,2H;M,?H  ♦/ 

3095 

C 

•••  initialize  active  grid  counters  and  define  CONSTANTS. 

3886 

C 

' 

3897 

NRTeO 

3690 

nRc  «0 

3099 

SU  ML  *  0 . 

3  85  0 

RE  Z  =  0  . 

3  8  5  1 

P  I  r>TS=  1  .  0/  (  P  I  nY»oT  1 

3852 

Trfnpnr  =  2*o,,PU>Y»oT 

3853 

no  iso  k’i.kmax  ; 

3059 

150 

P  <  K  1 aO. 

3855 

c 

3856 

c 

•  o  f  f  I  n  f  Radial  momentum  at  axis.  set  axial  momentum. 

3057 

c 

energy,  and  mass  flux  at  axis  to  0. 

3858 

c 

3859 

K*2 

3860 

00  200  J» 1  , J M  A  X 

386  l 

IF  (  AM* (k ) .LC.O* »  GO  TO  160 

3862 

I F 1 UCK | ,LT.O. )  GO  To  1 70 

3863 

1  60 

rt.EFT(j|  *  0. 

3869 

GO  TO  190 

3865 

c 

•  define  hass  flux  as  though  left  cell  uoundaky  *ere  not 

3866 

c 

thf  axis  -  after  mu  defined;  mass  flux  set  to  zero. 

3867 

c 

3868 

1  70 

CONTINUE 

3369 

178 

6AMCIJ1  =  AHX ( K 1 .U ( K | »DT/OX ( 1 > 

3  8  70 

IFIGAMC(J)  ♦  A..IXIK1  ,  GE .  0.1  GO  TO  180 

387  1 

GAMCIJt  a  -AHX(X) 

38  72 

18  0 

FLEET ( J )  =  2««GAMC(J)*U(K)/SS2 

38  7  3 

c 

3879 

190 

GAMClJ)  =  0, 

39  75 

YAllCljl  a  0, 

3676 

SIGCIJ1  =  0. 

3  87  7 

200 

K=K*IMAX  l 

3678 

c 

1 

38  79 

c< 

*  *  * 

3680 

c 

1 

390  1 

c 

PH?  COMPUTES  MASS  FLUX  TERMS  Of  PURE  CELLS  ONLY. 

3882 

c 

thf  mass  flux  terms  of  the  mixed  cfli s  have 

39  0  3 

c 

ALREADY  deem  COMPUTED  in  I MF  ACE  AND  FLUX. 

c 

PH?  ONES  THE  ACTUAL  TRANSPORT  FOR  [inTH  PURc  AND  MIXEU 

3605 

c 

CELLS, 

30  66 

38  6  7 

c 

c 

•  •  * 

1 

j 


74 


3888 

C 

3889 

C 

3890 

c 

•*♦  BEGIN  .LOOP  ON  I  -  PH2  CALCULATES  8  COLUMN  AT  A  TIME 

3891 

c 

3892 

00  I  I  SO  !■>•!! 

3893 

IF!  I GM  «  EO  * 1  IPlOrS*2./OT 

3898 

IF ( I GM.EO* II T VOPDT*OT/X ( 1) 

3895 

J*1 

3696 

K*l*l 

3897 

DO  205  NM  .  NMAT 

3898 

SDELEh ( N > =0. 

3899 

SAMMY  1 M )«0. 

3  9  JO 

205 

CONTINUE 

390  1 

I  F  1  A  MX  1  K 1 »  1220,230,210 

3902 

210 

MFK»IA3SlMFLAT,IK)  I  : 

3903 

c 

•  oF.riNE  fluxes  at  bottom  grid  boundary*' 

3904 

220 

iril-VIKll  ,GT.  UM1N(  GO  TO  240 

3  9  OS 

230 

amnv  =  0* 

3908 

GO  TO  290 

3-9  0  7. 

2.4  0 

IFIMFK.gT. 1001  60  To  245 

3908 

AMMY«  AMX  (  K  »  *  V  (  K  )  •llT/OT  1  J) 

3909 

I  F  (  AMM  Y  +  AIIX  (  K  )  ,l  r .  0,  )  AMMy«-AMXIK> 

39  10 

CELEBs ( A  1 X ( Kl * t U < K 1 »«2  ♦  4 1 K 1 • »2 1 • . S > • AMM Y 

391  1 

GO  TO  247 

39  1  2 

74S 

DELE8-0, 

39  1  3 

AMiiY  =  n. 

3914 

'  - . : 

MoMFK- 1 00 '  1  ' 

3915 

DO  2  46  N *  1  , NIlAt 

39  1  6 

SAMMY ( N) »KHO( M*M 1 *V { K» •nT»TAUI I |  ; 

39  1  7 

1  F  1  S  A  M  M  Y  1  N  1  ♦  X  M  AS  S  1  N  ,  M  )  •  L  T  •  0  •  1  SAMMY  IN  1  ■-XMAS-S  ( 11  ,M  ) 

39  |  8 

SDELEB 1 N ) ■ 1 5 1EI N ,M 1 ♦ (U 1(0  ••2*W«  K 1 *»2 1  * .5  1 «SAMMY (M | 

3919 

A  M  M  Y  =  A  M  M  Y  ♦  S  A  M  M  Y  (  N  | 

3920 

0El.EB  =  9ELFli  +  So  EL  E  B  (  M  1  •  '  ' 

392  1 

246 

CONT 1MU£ 

3922 

247 

1  E  ( CV ! S , GE *0 •  )  GO  To  280 

3923 

A  M  ,4  U  =  A  M  M  Y  «  U  {  K  | 

3924 

AMMV»AMMY*4(K1 

34  25 

EMOh  =  £  M  (J  b  +  '->ELEU 

3926 

i  TH  =  ETH  ♦  OFLF.P  "  ■  ■  ■ 

3927 

BOTH  c  BOTH  -  AMMY 

3928 

BOTMV  =  BOTriV  -  AM.4V 

3929 

BOTMU  =  UOJMU  -  A  MMII  •  ;  •  -  '  - 

3930 

GO  TO  300 

393  1 

c 

•••  REFLECTIVE  BOTTOM  BOUND4RY 

3932 

280' 

IF1  Vlk) »GE*0. 1  GO  To  2  33 

3933 

ANMV  =  2  •  •  A M M  Y  *  v  (  K  17 S S 2  , 

39  3  4 

290 

AMMY  =  0*  •  ■  '  ■  ■ 

3935 

ammu  =  o* 

3936 

OfLEH  =  M. 

39  37 

300 

CONTINUE 

3933 

c 

3939 

c 

3980 

c 

BEGIN  LOOP  ON  J 

3  9  *4  1 

DO  1140  J= 1,12 

7$ 


39  9  2 

VA80VE»0» 

3993 

URR«0  • 

3999 

AMPY»0 , 

3995 

3994 

c 

•••  oefine  fluxes  at  top  BOUNDARY  of  cell* 

3997 

c 

•••  L  IS  INDEX  OF  CELL  ABOVE  CELL  K, 

3998 

L  ■  K+IHAX  t 

3999 

c 

.  ’  !. 

3®50 

KFK-lABSIHFLAGlK  >  ) 

3951 

MFL*l/u3SIMFLAGIL) > 

3952 

IE < MFK.GT. 100)  GO  TO  670 

3953 

c 

SET  FLUX  TO  ZERO  IF  EITHER  CELL  IS  FLAGGFD  ZERO, 

3959 

IFIMFK.FQ.O  .OR,  (MFL.EU.O  .AND.  J.LT.JMAX))  GO  TO  360 

3955 

Ci 

•  •  * 

395* 

c 

3957 

c 

•  ••  SPECIAL  TESTS  FOR  .TOP  BOUNDARY  OF  rR  ID. 

3958 

310 

IF(J,EQ,JMAX  .and.  V  I  K  )  •  G  T • 0 . )  GO  TO  320  i 

3969 

IE  I  J,f  |J.  UMAX  .AND.  VCKt.LE.O.)  GO  TO  360 

3960 

IF  (  A M X  I  K »  )  1270, 360,319  ' 

396  1 

c 

3962 

3  19 

I E  t  A  M  X ( L 1  1  1220.315,3)6  -  , 

3963 

c 

•••  CELL  ABOVE  EMPTY,  SHOULD  TRANSPORT  INTO  IT  BE  ALLOWED 

3969 

315 

I E < V ( K ) . GT . 0.  .AND*  MFL.GT.IOOl  GO  TO  320 

3965 

GO  TO  360 

3946 

c 

•  ••  MOTH  NON-EMPTY 

3967 

316 

*SA= I V ( K  )  *V ( u  1  )  *  .5 

39  6  ft 

*S«DT/DY(J> 

3969 

».SB»  1 ,0+  (  V  I  L  ) -V  1  K  >  )  *WS 

3970 

IE(ABS(V(K)1*wS.GT.STaB  .or.  ABSI V(L>)*#S.GT.STAB)  wsb»i.o 

397  1 

VAQOVEaWSA/lVSR 

3977 

c 

3973 

IE  (  AI1S  (  VAB0VE  )  .LT.UMINI.  GO  TO  360 

3979 

JF ( VAROVE)  319,360,329 

3975 

319 

IF  1 MFL.GT. 1 001  GO  TO  350 

397  4 

c 

•  ••  DONOR  CELL  I  ABOVE )  IS  PURE 

3977 

H«L  !'■.,< 

3978 

01 OOY  =  DT /OY 1 J*  \  ) 

3979 

GO  TO  326  ! 

3  9  6  0 

c 

*••  CELL  ABOVE  EMPTY,  ■  |  . 

3991 

320 

VABOVE«VlKI 

3982 

c 

DONOR  CELL  IK)  IS  PURE’ 

3983 

329 

M  *  K  | 

3989 

D  T0DY»OT/D  Y  I-J  » 

3985 

c 

•••  FLUX  DEFINITION  FOR  PURp  OON0R.  ' 

3986 

326 

AMPY»aMX(M).VaBOVE*DTODY 

3987 

60  TO  955 

3  9  P  3 

c 

•••  DONOR  CELL  (ABOVE)  IS  MIXED.  TRANSPORT  ONLY  CtLL  K  MA 

3969 

350 

I  F ( XMASS  I  MFk  ,MFL- l 00 ) .LE.O. )  GO  TO  360  ; 

3990 

AMPY»RHDlMEK.MFL-1001*VAB0VE«OT»TAU(I) 

398  1 

F.  AMPY*SIE  (  MM:  ,MFL-I  ODI  ♦  .b*IU(L)**2  *  V  t  L  )  *  •  73 

3992 

M  e  L  | 

3993 

GO  TO  958 

3999 

c 

...  MO  FLUX  across  TOP  BOUNDARY  OF  cell  k* 

3995 

360 

AKPY=C.  ; 

76 


3996 

60  TO  MAO 

3997 

c 

*••  00>'O3  CELL  PURE  • 

3998 

MSS 

CAMPY  *  AIXII1)  +  .  5  •  t  IJ I  M  )  *  •  2  ♦  V (M ) **2 1 

3999 

c 

9000 

MS  8 

UAMPY  •  U(M) 

MOO  1 

VAMPY  =  V  <  M  ) 

H  0  0  2 

IE(ASS(A«P7).flT.R0EPS»AHX(K>  .AND.  A M X ( K  )  . 6 T . 0  .  )  GO  TO  MS? 

M  0  C  3 

1  F  t  AfiS  I  AMPY  |  .<;  T  .ROEPS*  AMX  (L  )  .ANO.  A  M  X  (  L  )  .  G  T  •  0 . 1  GO  TP  M&9 

MOOM 

ampy*o. 

MOOS 

MS9 

DELET*  aMPY»EAMPY 

MP06 

c 

•  ••  l  IS  INDEX  OF  CELL  TO  R  f  6H  T  OF  CELL  K • 

M0C7 

MAO 

L  =  K+  1 

MODS 

c 

•  »«  OEFIS'E  FLUXES  AT  RIGHT  BOUNDARY  OF  CELL. 

MOO? 

MFL»lABS<MKLAG<L) 1 

MOiO 

c 

•  SET  Ft_UX  TO  2ER0  IF  CIThE*  CELL  IS  FLAG&FD  ZERO. 

M  0  t  I 

IFImFk.EQ.C  .OR.  lhFL.Eii.O  .ANO.  I.LT.IMAXI)  GO  TO  560 

MO  1  2 

c 

Mp  1  3 

c 

•••  SPECIAL  TESTS  FOR  RIGHT  fiOUNDART  OF  GRID. 

MD  1  M 

SIO 

I  F I  I  *E 0. I  HA  X  .AND.  tHKJ.GT.O.J  GO  TO  520 

MOIS 

I  F  1  1  •  E  0  *  I  H  A  X  .AND.  U  <  K  1  . 1.  E  *  0  .  )  GO  TO  560' 

M  0  1  6 

IF  I AMX ( K  )  )  12?C,560  ,SIM 

M01  7 

c 

IS  CELL  ON  RIGHT  EMPTY? 

MO  t  8 

S  1  M 

IF ( AMa  <L  > I  !  220 .515,516 

MO  I  9 

c 

•••  YES.  DOES  IT  CONTAIN  A  MATERIAL  INTERFACE? 

M  0  2  0 

SIS 

IFIL'IK  1  ,GT.O.  .AND.  MFL.GT.100)  Go  TO  S20 

M  0  2  l 

GO  TO  S60 

MO  2  2 

c 

both  CELLS  ARF  NON-EMPTY.  COMPUTE  TRANSPORT  VELOCITY 

M  0  2  3 

S  1  6 

S  A  *  (  U  (  K  1  +  u  (  L  I  )  *  .  5 

M  0  2  M 

*S*DT/DX II) 

M02S 

wso*  i , n* ( u ( l i -u  t k ) ) aws 

MO  2  A 

I  F  (  APS  (  U  I  x  >  )  •"'S  .  0  I  «STA(j  .OR.  AIJSIUiL)  )»Y/S,GT.ST  AB)  1158*1. U 

MO  2  7 

URR*Y'SA/V«S  3 

M028 

c 

M02? 

I  F  < ABSIURK  1  .LT.OMIN)  GO  TO  560 

M  0  3  0 

IF(uRR)  519,  560,  57M 

M  C  3  1 

5  I  9 

i f ( mfl . gT  .  i  nc >  go  To  sse 

M  0  3  2 

c 

•••  pONOR  CtLL  ON  RIGHT  IS  pURE« 

M  0  3  3 

M  =  L 

MD3M 

AREA'TAlM  1 ♦ 1  ) 

M  0  3  S 

GO  70  52* 

M  0  3  A 

c 

•••  CELL  ON  RIGHT  EMPTY. 

m  0  3  7 

5  20 

U«W*U(K) 

M  P  3  8 

c 

•*«  DONOR  CELL  *  IS  PURE, 

M  0  3  9 

5  2“ 

H  =  K 

MOMO 

AREA*TAU< 1 ) 

MOM  1 

c 

•  MASS  FLUX  IF  DONOR  IS  P(;RE 

M  0  M  2 

526 

A  M  N  P  *  A  M  X  (  M. )  /  A  F  F.  A  »  T  :V  0  P  p  1  •  X  I  I  )  •  U  R  R 

MOM  3 

GO  TO  655 

1  p«  M 

< 

•  »»  OCf-CR  CELL  UN  RIGHT  is  MIXED.  TRANSPORT  only  cell  K 

“CMS 

l 

material. 

MCM  A 

550 

IFIXMaS5<MFX,*'FL-I0CI.LE*0*1  80  To  560 

*♦  0  M  7 

amMP*Rho!MFF , " t L -  1 C p ) • D  K  R • T  * 0  P D  T *  X (  1  1  • t Y  ( J ) 

»i  p<*  9 

f.  A  M  pps  s  I  E  <  Mf  X  .  Mr  L  "  1  CO  >  *  .5*IUILl**2  a  VCD**?) 

U  IJ  M  9 

h  *  L 

77 


<♦060 
MCS  l 
H0S2 
••05.3 
MOSH 
**055 
MOS  A 
M  0  S  7 

moss 

MGS9 
<*060 
“06  1 
h  n  6  2 

MC)6  3 
«OAM 
*<065 
MCA  4 
M  0  A  7 
MCA  8 
M069 
M  0  7  0 
M  D  7  1 
M(1  72 
M  0  7  3 
M  0  7  M 
M  0  7  5 
MO  7  A 
M  0  7  7 
M  0  7  8 
M079 

Mneo 

MP8  1 
M  0  8  2 
M083 
MppM 
MOPS 
M  0  8  A 
M087 
Moea 

M  0  8  M 
Mp90 
M09  1 
MO  9  2 
M  0  9  3 
M  0  9  M 
M  P  9  5 
MO  9  A 
M  0  °  7 
MP9  8 
8  0  9  9 
M  1  0  0 
Mini 
M  I  0  2 
M  I  0  3 


GO  TO  ASS 

•  ••  NCI  FLUX  ACROSS  RIGHT  BOUNDARY  0Ff  CELL  K, 

AMMP*0. 

GO  TO  960  ' 

0  0*! OR  CELL  PURE. 

EAMMP  *  A  t  X  (  M  )  ♦  ,S*<U<M)»»2  ♦  VIM)»»2> 

UAMMP  ■  U<H) 

VAMhP  s  V(M) 

1 1:  <  ABS  (  aHmP  I  ,  gT  .  ROEPS*  AMX  (  K  I  •AND.  A M  X  (  K  I  .  G T  •  r>  .  I  GO  TO  AS9 
IF l A9S I AMMP ) .fiT. R0EPS*ANX <L )  • AMO .  A M X t L  )  .  G T  .  0  •  >  GO  TO  AS? 

A  M  M  P  «  0  . 

oeler=  ammp»e/mmp 

GO  TO  960 

.  CELL  K  M1XEU.  COMPUTE  ENERGY  FLUX  FOR  EaCM  MATERIAL 

670  MK«mFk-|00 
DELtR=0. 

DELET=o. 

A  h  P  Y  *  0  . 

A  N  N  P  a  0  , 

Xl-K 

*k  =  k 

H  T=MK 
M  R  *  M  K 

00  680  N«J  iNMAT 
IF  I  SAPPY  I N  iMK ) >  690.680,700 
680  CONTINUE 
GO  TO  70S 
690KT=K*|MaX 

mT*|ABS(MFLAGIKTJ  I“ltl0 

A  S  >  »  A  I  X  (  K  T  I 
700  UAMPY=u<KT) 

VAPPVeVIKTI 
70S  00  710  N= 1 , UMAT 

[F ( SAMMP I N ,MK ) )  720,710,730 
710  C0M1NUE 
GO  TO  7  3  S 
720  KK=K*| 

MR* 1  A  es ( Hf  L AG  <  KR  I  1*10  0 
AS Y  *  A  I  * ( KN  ) 

730  UAMMP.U(AR) 

VAMMPbVIKKJ 

73S  A5Aa,ij»(U(XT)**2  ♦  V  (  K  T  I  *  •  2  ) 
wSB*.S»(U(AP)»»2  ♦  v ( F  R I • *  2 ) 

00  SOU  N= I »nMaT 
SOELETUiUO. 

soelerim>*o. 

I F  ( ABS  I  SAPPY  I  N  ,MK  )  )  .LE.C.  )  00  TO  760 
I  F  <  rt  T  .  G  T  •  0  >  IASX*SIE(N,MTI 

SDELET(N)sSAMPY|N,HK)*(»SX-*PSAI  1 

DELET  =  DLLET  +  SnELET  <  v  ) 

AMP  Y  =  AMP  Y*SAMJ  Y  (  N  .MX  ) 

7  6  0  I E ( A8S ( SAMMP ( N  ,HF )  I  ,LE .0. )  GO  To  7  8  P 

IF  (MR.GT.01  »SY=SIE IN, HP  I  i 


SAD 

ASS 

asb 


AS  9 


9  1  C  *» 

SD£LER(N)*0AMMP(U,MK)«(*SV**SB> 

9irs 

OfLER»DCLER*SOELER(N) 

9  106 

AMMH-AMMP+SAMMP(n,MK) 

9  t  0  7 

760 

SDeLM(NI>>-SAHPY(N,MK)-SAMHP<N«MK)+SGA*C(N,J>*SAMMY  In) 

M  |  CP 

800 

CONTINUE 

* 

H  109 

h*HK 

V 1 1  o 

960 

OELM*-AMPY-aMmP+GAMC 1 J) ♦  ammy 

**111 

970 

IF  (  A8S  (  AMPY  )  .I.E  •  3.  »  GO  TO  980 

9  I  1  2 

C 

CALCULATE  ENERGY  AND  MOMENTUM  FLUX  AT  TOP 

* 

Jp** 

9113 

AHUT«AMpr*UAHPY 

9  119 

AMVTBAMPY • vampy 

9115 

c 

IS  THIS  AT  TOP  BOUNDARY 

9|  1  A 

IF  (J.NI.JMAX)  GO  TO  9  9  C 

9  117 

c 

YES, TOP.  ADJUST  ENERGY. 

9118 

ETH»ETH-DELtT 

9  119 

EHOT»E«oT  +  OE|.FT 

9  1  20 

T  OPM=TOPM+ AMPY 

9  121 

tophv=topmv*amvt 

9122 

TOPMU  =  ToPhU  +  AH'JT 

9(23 

c 

IS  AMPy  large  ENOUGH  TO  TRIGGER  REzQNE 

9  129 

IF  (AMPY/{TaU<JI»DY(J»).GE.VT>  R  E  2 “ 1  • 

9|25 

GO  TP  990 

9  |  26 

c 

ampy=o,  set  momentum  and  energy  elu*»o. 

9  1  27 

9  BO 

AMUT»0 . 

9  128 

A  M  V  T  -  0  . 

9  1  29 

delet=o. 

9  1  30 

990 

IE  1  ABS  1  AMMP) .LE .0 • )  GO  TO  1000 

9131 

C 

CALCULATE  ENERGY  ♦  MOMENTUM  FLUX  AT  RIghT 

9  132 

AMUR»AMMP«UAMMP 

9  l  3  .3 

arvrcammp* v ammp 

9  1  39 

c 

IS  THIS  AT  RIGHT  boundary 

9  l  35 

ip  1  I .NE. IMAX )  GO  To  1U10 

9  136 

c 

YES.  RIGHT.  ADJUST  ENERGY • 

9  1  37 

£TH«ETH*DELER 

9  1  38 

emor*emqr*oeler 

9  139 

rtm=rtm*ahhp 

9  180 

PThV'RTMV+AmVR 

9  19  1 

ktmu=rtmu+ Amur 

9)92 

c 

IS  AMMP  LARGE  ENOUGH  10  TRIGGER  REZONE 

9  193 

IF  1  AMMP/ < T AU  1  11 «U Y < J I  I  .GE  .  VT  I  RE7* 1  * 

9  |  99 

60  TO  1010 

9  1  85 

c 

ammp»o.  set  MOMENTUM  and  ENERGY  FLL'X*U. 

9  |  96 

Ifioo 

AMiJKon  . 

9[87 

amvr=o. 

9  198 

DELFR=0» 

9  199 

c 

REPARTITION  energy  ♦  MOMENTUM 

9  150 

1010 

CONTINUE 

9)51 

i  n  2  n 

USA  =  .5MUtK)»*2*Vll‘l*«2> 

9  152 

SIGMU=-AHUT-AMUR*AMMU*ELEFT(JI 

9  153 

SIGMV=-aMVT-A‘'VR*AMMV+YAMCIJ) 

- 

8  159 

WS  =  Mf  t.M*A MX  IP  1 

9  155 

UNf  'A  =  (  S  1  GNU  ♦  A  »i  X  |  K  )  »  L  1  K  II  /  u  s 

8  156 

D  t  L  U  =  U  N  F  A  -  U  1  K  ) 

9  157 

U<K)=1INF« 
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*(168 

>030 

VNet*«<S!GHV*AMX<tC  >*V«KiJ/WS 

•4  |  59 

OEl_V»VNE«-V  (K  ) 

4  1  60 

V<K)«VN£W 

4  l  61 

SlEN£W*0* 

•4  1  62 

C 

•  ••  IS  CELL  K  PURE  7 

4(63 

IF  IMfK.LT.lOnl  GO  TO  104D 

4  164 

c  •  •  •  • 

*4  1  65 

c 

AND  FOR  ENTIRE  CELL. 

*4  166 

(VSbQ. 

*4167 

T  1  E»0. 

•4  J  68 

MK=MFk-100 

**  1  6  9 

DO  1 038  N« 1 , NMAT 

•4170 

IF ( ABS ( SOELM 1 N )| .LE ,0. )  GO  TO  1037  r 

**17  1 

c 

TOTAL  energy  CHANGE  FOR  MATERIAL  N  ■  SUSr 

*4  172 

SWSB  «  -50ELET  (N)-SOFLER  (  Nl  +SS  1  GC  111,  J)  ♦S0ELE8  (N) 

<4  173 

c 

**•  NEW  VALUE  FOR  MASS  OF  MATERIAL  N  ■  SY.S  ( N ) 

<4  1  7*4 

SWS  ■  SOELMINI+AmASSIN.MI 

<4  l  75 

IFlARSISWSI .GT.O. 1  GO  TO  1034 

<4 1  76 

SIE(N,MK1»0. 

<4  177 

XMaSS(N,M<)«0, 

<4  178 

GO  TO  1038 

■4  179 

10  34 

S  W  S  A  “  (  (  S  I  cT  4  N  i  MK  )  ♦  Y(  S  a  1  •  X  M  A  SS  ( N  *  M  K  1  +  SWSBl/SWS  -  .  5  •  (  U  (K  )  •  •  2  ♦ 

<4 1  BO 

V 1 K ) • *2  ) 

<4101 

0ELl*S'6SA-5lFlN,MK) 

<4182 

IF  1 ABS10EL I > ,GT.UMlN*»2)  GO  TO  1035 

9  103 

SUME=5UmE.0el1»S*S  1 

<4  189 

CO  TO  1036 

9  l  B  5 

1035 

S  IE  IN  ,MK > =SWSA 

9  106 

1036 

XMASS  1  N  ,MK  •  »  S  A  S 

9  187 

1037 

6S*,lS»XMASS(N,MKl 

9  188 

III.Tie  ♦  Am A SS 1 N , M« 1 *S I E < N . MK )  • 

4  1  89 

1038 

CONTINUE 

9  1  90 

IF  (  A9S I  AS > .LK.O. )  Go  TO  1050 

4  19  1 

S  1  £  N  E  W  ■  T  I  C  X  V,  S 

4  192 

GO  TO  1060  ,  - 

4)93 

C 

*4  |  9  <4 

-  c«  •  •  • 

»••••••••••  CELL  K  IS  PURE  . 

4  1  9  S 

c 

4  196 

10  4  0 

*»Sb  =  -0ELET-dELER*0ELEB  +  S  1  GC  <  J> 

4  197 

IF  1  ABS ( AS ) -UE.O. 1  GO  TO  1050 

H  1  9S 

SlENEWa  I  (  A1  X1K>*WSA  )  «AMX  1K>  t«SBl /»«;•  .  S  •  <  U  (  K  1  *  •  2  ♦  V  <  K  1  •  *2  ) 

4  199 

DEL ! =5 IENL4-A IX ( K ) 

4  200 

IF  1  ABSloEL  n  .C,T.UM1n*«2)  go  TO  1050 

420  1 

SUME*SUmE*UEl  I  •‘.vs 

4202 

GO  10  1060 

4203 

>050 

A  I  A  (  K  )  =s  IENEW 

4204 

1060 

AMX(K)x«v5  - 

4205 

lfl90 

IF  (l.NE.ll)  SO  TO  HOC 

4206 

lF(A8S(U(<)».GT.O..OR,AB5(V{K»).Gr.O..OR.A8S<AtX(K)),GT.O.)  Nrc» 

4  20  7 

C 

**•  SPECIAL  INTERMEDIATE  PRINT  FOR  CHECKING  ENERGY 

4  208 

C 

CONSERVATION  -  PRINTS  ONLY  IF  INTER  b  7  IN  INPUT  DECK 

4209 

lino 

IF  I  INTER. HE. 7 1  GO  TO  1 i 30 

42  10 

ENERGY*DElER«OELET-S TGC  I  J» 

42  11 

OQ  1110  N:1=]  I.IMAX 
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<4266 

AHKU-AMuT 

<4267 

amnv.amvt 

*4268 

0ELEb»DELET 

*4269 

C 

<4270 

C 

•  ••  END  Of  J-LOOP* 

<427  1 

c 

<4272 

1  1  90 

♦ I  HA  X 

<4  7  7  3 

LL  =  K-fMA.X  ,  _  „ 

<4  2  7  <4 

|  F  (  A  8  5  4  U  4  LL  )  1  ,GT,0*.0P.aB5(VILL)  1  .  c;T»0».0R.ABSlAlX(LLl  '  «6T  .  0«  1 

<4275 

H  R  T  ■  1 

<4276 

c 

<4?77 

c 

•  **  END  OE  I  -LOOP • 

*4278 

-  c 

<4279 

1  150 

CONT !  NUE 

<4280 

c 

•  ♦*  ADVANCE  ACTIVE  gr  1  d  • 

<4  28  1 

IUI1+NRC 

<<2P2 

1 2“ I 2  +  NR  T 

<4  783 

ir  ( IN AX- I 1 )  1 1 60 • 1 1 70  » 1 1 8C 

<4  28  <4 

1  1  60 

1  1“IMAX 

<4285 

1  1  70 

CONTINUE 

<4286 

1  1  80 

f  E  (JmaX-12)  1 1 90  i  1 200  i  1 2 10 

<4267 

1  |  90 

1 2  *  JM  A  X 

<4  2  8  B 

1  200 

CONT 1NUE 

<4269 

1210 

GO  TO  1230 

<4  290 

c 

NEGATIVE  pass 

<4  79  1 

1220 

N  K  =  3  1  5 

<4292 

NR*  13 

<4  293 

1  225 

call  ehror 

<429*4 

1230 

SUH=0.0 

<4295 

C 

...  MAKE  ADJUSTMENTS  f or  ovfr-emtied  cells 

*4296 

00  1280  Jp-l  •  1 2 

<4297 

DO  1270  1*1.11 

<4  298 

J«  JP 

9  299 

IE4  J.LE.J4'R0J.0R,JPP0J,E«.01  GO  TO  1281 

<4300 

J=  1  2- JP  +  JPRo J* 1 

<4  30  1 

128  1 

K=(  J-l  1MMAXMM 

*4302 

C 

<4303 

hFX*lABS(MFLA6(K) ) 

<4  30*4 

IFlMFK.GT. 100)  GO  To  1226 

<4  305 

IF t AM* ( K ) . GE« 0« )  GO  TO  1270 

<4304 

c 

...  PUPE  CELL  0 V E R“E NT  I  ED 

<4  307 

AR ITE  <  6  *  1700  I  I  » J 

<4308 

NK. 1 226 

<4  309 

NR  =  1  3 

<43  10 

CALL  ERROR 

*4  3  1  1 

1226 

DO  1  227  L  c 1  ,NMAT 

<43  12 

)  F  4  XMASS  1 1  »  ME  K- 1  CO  >  .-l  T  )  GO  TO  1728 

93  13 

1227 

CONT INUE 

9  3  19 

GO  TO  1270 

93  15 

C 

MATERIAL  L  (  IN  A  MIXED  CELL)  0 V E R-E MF T I FO • 

931  6 

1  228 

K«L 

9317 

P»HEK- 1  no 

93  18 

A  S  X  .  X  N  A  S  S  1  N  ,  M  ) 

9319 

A  5  Y  =  5  !  F-  4  H  .  P  ) 
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*♦212 

€N£fiGY»ENKRG7*S!r,c(NN) 

92  13 

t  1  in 

CONTINUE 

9219  ' 

00  1120  LJ0a2,KMAX 

9215 

EN£RGY»ENEf<<;Y  +  AMX(LJDl*(AlX(UJD)  +  ,6*tU(LJD)**2  +  V!LJol**2)) 

9216 

1  120 

CONTINUE 

*♦2  17 

WRITE  (6.  13001  I, J, ENERGY 

92  18 

W«lT£  (6il3ini  AMPY  ,  AMflP  ,  AtlMY  ,6AMC  t  J  1 

<*21? 

WHITE  (6,13201  DELET,nELEK,DELEB,SlGC(J) 

**220 

IP t  1  AOS (MTLAC (K |  1 .LT , 1 00 >  bO  TO  1130 

**22  1 

WRITE  (6, 132  11  (N.SOFLF.Tltl)  ,  SOELER  l  N  1  ,  SDELEB  <  N  1  ,SSI6cIN,J1  , 

**222 

N» 1 ,NMAT ) 

<*223 

1321 

FORMAT (  I3.BH  S0ELET»1PE15.B,6X,7HSDELER«IPE15.8,6X*7H50ELEB«, 

<*22<< 

1  1PE|5.B,6X,6MSS!GC»IPEI5.8) 

9725 

1  1  30 

cont  t  NUE 

<*226 

C 

•••  IS  CELL  K  TURE 

<*227 

IF (MFK.GT. 100)  GO  TO  1131 

<*228 

IFIMFK.gT.O)  GO  to  1139 

**229 

00  1133  N®  l  ,  NM  A  T 

9230 

S  Alt  M  Y  (  N  1  *0  . 

<*231 

SOELFBINIbO, 

<*232 

SGAMC 1 N , J 1 “0. 

<*233 

SS1GC<N,JI«0« 

**  2  3  <* 

1  133 

CONTINUE 

<*  2  35 

GO  TO  1 | 38 

<*236 

C 

<*237 

C  ♦  •  «  • 

<1238 

c 

of  each  material  for  cells  above  and  on  right. 

<*239 

c 

<*2<*tl 

1131 

continue 

<*2<*  1 

do  1132  N»1,NMAT 

**  2  **  2 

SAMMYINl  a  SAMpYIN.MK) 

<*  2  **  3 

SDELEH(N)  “  sdeletini 

*1299 

SGaMCIN.J)  a  S»MNP(N,MK) 

<*2<*  5 

SSIGCIN.J)  "  SOELER 1 N 1 

9  2  9  6 

1  1  32 

CONTINUE 

<*  2  <*  7 

GO  TO  1 1 38 

**298 

C 

9299 

Caaaa 

9250 

c 

ABOVE  AND  ON  RIGHT. 

9261 

c 

9262 

c 

•••  IS  CELL  ABOVE  PURE? 

9263 

1  139 

IF  1  I  A6S (MELAG (F  +  I MAX )  1 .LT. 1001  GO  TO  1136 

9269 

SAMMY(MFK)  a  AMPY 

9255 

50ELEB(MFK)aCELET 

925* 

C 

•••  IS  CELL  ON  RIGHT  PURE? 

9257 

1  1  36 

IF  I  I  ABS(HFLAG(K  +  1  II  ,LT.  ICO)  GO  TO  1138 

9268 

SGAMCIMEK.J)  a  AMMP 

9259 

SS 1 GC IMF K , J) =PELER 

9  260 

C 

926  1 

1  138 

GAMC(J)aAHMP 

9262 

FL[ FT ( j ) a  AMUR 

9263 

Y  AMC 1 J 1 =  AH VR 

9269 

S I GC 1 J I =DELfR 

9765 

A  M  h  Y  a  A  ri  P  Y 
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*32  0 

XHASS(N,M)-0. 

*321 

SU1N,H)»0. 

*322 

KSoAMX  <K 1 “USX 

*323 

A  1  X  (K | a ( A  I X ( K | »*HX <K)“*SX**SY 1/*S 

*32* 

AMX(K)a*S 

*325 

1229 

UN£l»»0* 

*324 

VNEA'.o  • 

*327 

SIEN£rt=0. 

*328 

rs»c. 

*329 

C 

•••  FIND  NEIGHBOR  WITH  GREATEST  AMOUNT  OF  ThaT 

MATERIAL 

*330 

C 

*«•  ft'HICH  HAS  OVER-EMPTIED. 

*331 

KT=K*|MAX 

*332 

. 

1 F  1  J.EQ.JMAX1  GO  TCi  1236 

*333 

I  T*  1 

*33* 

JT*>J*| 

*335 

123  1 

MT»IABS(HFLAG(KT1 1 

*336 

IF1MT.LT. 1001  60  TO  1232 

*337 

6SA«XMASStll,MT-10CI 

*338 

GO  TO  123* 

*3  39 

1232 

IF1MT.NE.NI  GO  TO  1234 

*3*0 

W  5  A  a  A  M  X 1 KT 1 

*3*  t 

123* 

1F16SA.LE.HS)  GO  TO  1236 

*3*2 

6  S  a  6  S  A 

*3*3 

N  6  S  »  K  T 

*3** 

1236 

IFIKT.NE.K*IHAXI  GO  TO  1 2  3  B 

*3*5 

KT  aK- | 

*3*6 

IFl  1  .EQ. 1  I  GO  TO  1238 

*3*7 

I  T  *  1  -  l 

*3*8 

J  T*  J 

*3*9 

GO  TO  1231 

*350 

1238 

IF1KT.NE.K-1 1  GO  TO  12*0 

*351 

KTaK-lMAX 

*352 

IF1J.E0.1I  GO  TO  12*0 

*353 

1  T  =  I 

*35* 

JT=J-1 

*355 

GO  TO  1231 

*356 

1  2*0 

IF  (KT.NE.K-!M»X)  GO  TO  12*2 

*357 

KT=K* 1 

*358 

IF  1  1  ,EQ.  IMAX )  GO  TO  1 2*2 

*359 

1  T  a  I  ♦  1 

*360 

J  T  =  J 

*36  1 

60  TO  1231 

*362 

12*2 

IF  1 ftS.GE.ABSIWSX)  1  GO  TO  12** 

*363 

ft R  t  T £  t  6 . 1 *50  1  I  , J ,MFK 

*36* 

WS=(UlKl*aZ  ♦  VlKl**2)/2.0 

*365 

EVAPMaEVAl’M  ♦  WSX 

*366 

ftS=ASX» 1 6SY*WS 1 

*367 

EVAPENaEVAPEN*WS 

*368 

ETh  a  eth-ais 

*369 

EVAPMU=EVAPMU+rtSX*U(Kl 

*370 

EVAPMv=EVAPMV+ftSXaVIKI 

*371 

VVR  I  TE  1  6 , 1  *60  1  1  ,  J.N.MFK  ,V»SX  ,  «ST 

*3  72 

GO  TO  1269 

*373 

C 

••a  REMOVE  Hass  FROM  CHOSEN  NEIGHBOR  (NWS)  AND 

adjust 
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4374 
<4375 
437  6 
**377 

4378 

4379 
4  380 
**38  1 
4302 
9  3  8  3 

4384 

4385 
4  386 
4387 
4  388 
4389 

43  VO 

4391 

4392 

4393 

4394 

4395 

4396 
439  7 

4398 

4399 

4400 
4  40  1 

4402 

4403 
4  404 

4405 

4406 

4407 

4408 

4409 

44  10 
44  11 
44  12 
44  13 
441  4 
44  15 
44  16 
441  7 
44  18 

44  19 

4420 

4421 
44,22 

4423 

4424 

4425 

4426 

4427 


C  KINETIC  ANO  INTERNAL  ENERGIES  . 

1284  MFNaJ A8S(MFLAG(NWS) ) 

AHsaMK ( N*S 1 *(Y5X  ' 

VNEW«( AM* IN*SI*VINriS>  ♦  WSX«V(k))/AM 
UNttt»lAMX(N»S!«lHMiWS)  *  «SX*U(K)I/AM 
*5  A«  .5*  (  U  (  N'.’/S  )  «  »2  ♦  V(NWS)«*2) 

WSH».5»<UNE»»»2  ♦  VNE'*(»«2)  >  . 

ilSC«.5»(U(K)*»2  +  V(Kl»»2l 

IE ( INTER. EO. 01  GO  TO  1246  , 

WRITE (6, 888)  l  ,J,MFK.MEN.L.N#S,WSX,WSY,AM,VTK|  ,V(NWsl  .VNEW 

888  F0RMAT118H  ! , J . ME K . Mf N . L • N*S • 6 | 6 / 28H  4(5  X  ,  WS  Y  ,  A  M  ,  V  <  K  )  .  V  I  NWS  )  i  V  NE» 

l  l P  6E 1 5 • 7  1 

1246  CONTINUE 

EK  =  ASX»  (ViST  +  7, 'SC> 

IEIMFN.GT. 100  I  GO  TO  1260 
c  CELL  (NWS!  IS  PURE. 

ENNS«AMx  (  N.YS  I  •  <  A!  X  (  NWS  I  ♦  WSA)  j 

SIENEA  a  (EK+ENTSI/aM  -  (VSB 

GO  TO  1268  i 

C  •••  CELL  (NWS)  IS  NIXED. 

1260  MENaMFN-100 

ESUM=Q.  j 

SUMaQ, 

XMaXMASS ( N  .MEN  1  ♦  1MSX 
IFI INTER. EQ.O)  GO  TO  1261 

WRITE(6,889)  IT  ,  J  T i  M  F  N  ,  (XMASSIL.MFn)  ,SIE (L .MEN)  ,Lal  >MAT  ) 

889  FORMATI22H  IT.JT.MEN,  XMaSS,  SIE.  J  I  6  ,  /  4  0  x  ,  (  I  P  2  E  2  0 . 8  )  ) 

1261  CONTINUE  , 

DO  1  266  La  1  , N4AT  j 

IE (L.EQ.N)  GO  TO  1282 

I E ( A8S < XM*SS ( L .MEN  1 1 .LE . 0.  1  GO  TO  1266 
S  IE  <  L  ,MEN  )  «*S  I  E  <  L  .MEn  I  ♦(  WiA-wSB  )  ; 

GO  TO  12*4  I 

1262  TE  a  XMa5S(L»mFN)*(51E(L»MFN)  ♦  A'SA)  ♦  EK 

5IE(L.mfni  =  te/xm  -  visa  ! 

XMASS (l .men ) =XM  ! 

1264  ESUMaESUM*5IE(L,MFN)»XMASS(L.MFN) 

SUMaX.MA5SlL.MEN)  *5118  ; 

1266  CONT  I NU  F 

l  F (  INTER.E0.Q1  GO  To  1267 

»3  RITE  (6,839)  I  T  ,  JT  ,  MEN  ,  (  Xm  ASS  I  L  .  MEN  I  .  S  I E  (  L  *  NFN  I  ,L»  i  AT  I 

1267  CONTINUE 

S  l  ENE’V  =  ESUM/SUM 

1268  A  M  X  I  N  V.  5  1  a  A  M 
U  ( IMS  I  aUNC«» 

V ( NWS  1  a  V  MEW 

Al  X  (NvVS)aSlElir'V 

IF ( INTER. EO.O)  GO  TO  1269 

(TRITE  (6, 887)  SIENE* 

887  FORMAT (  7H  SIENER.  IPE20.8I  i 

1269  CONTINUE 
C 

IF ( ABSIAMX (K ) 1 .GT.Q. )  GO  TO  1226 
A  I  X  ( K  1  an. 
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<*•(28 
•4*429 
*4  *4  3  0 
**<431 
•4  *4  3  2 
•1433 
0030 
003S 
0036 
0037 
0038 
•4  *4  39 
0000 
•4  *4  *4  1 
0002 
000  3 
0000 
•4  <4  *4  S 
•4  »» H  6 
0*4  <47 
44*4*48 
0009 
8*450 
005  1 
0052 
0053 
0050 
0  055 
0056 
0  057 
0058 
0059 
0040 
006  1 
0062 
0  0  63 
0060 
0065 
0066 
0067 
0068 
0069 
0070 
007  1 
0072 
0073 
0070 
0075 
0  0  76 
0077 
0070 
00  79 
00  0  0 
000  1 


U4K)«0. 

V  t  K ) *0 • 

IF4MfK.LT.  103)  MFLAG ( K 1 
1270  CONTINUE 
1280  CONTINUE 

C  •••  EVAPORATE  MASS  NOT  EVACUATED  DUE  TO  MACHINE  ROUND-OFF, 

DO  1650  K-2.KMAX 

H»| ABS4MFLAG1K1 > 

IF  CM.lt. 1001  GO  TO  1650 
M=M-inO 
T I E “0 . 

00  1620  N*l  i  NMA  T 

IF(BHOCN.M) .GT.O.  .OR.  XMA SS ( N , M) , lE • 0 . 1  GO  TO  |6l5 

WSa  (  U  (  K  )  *»2  +  V  (  K  )  *»2  | /2..0 

0IFF»XMaSS(N,M1 

E  V  A  PMsE V  APH*  D IFF 

WS  =  o  I  FF.  (S1E4N.M1.44S) 

EVAPEN«EVaPEN  +  I0S 

eth*etm-*s 

CVaPMU=EVAPMU.D 1FF*U4K 1 
EVAPMV=EVAPMV.D1FF»V (Kl 
J *  4  K ”2 1/1MAX.1 
!»4K-1 )-|MAX»4 J-l ) 

Aft  |  TE  1  6 , 1  030  )  I  ,  J.N  ,  XMASS(N.M)  ,RHOf  N.M)  ,SIE»N  ,.M) 

AH*  (K  1  "AM*  4K  I  -!>  1  FF 
XMASS(N,MI=0. 

SIEIN,M)bO. 

1615  TIE»TiE+S!E(M,M)«XMASS(N.M) 

1620  CONTINUE 

A  I  X  (  K  1  *  T  IC  /  A  M  X  4  K  I 
1650  CONTINUE 

C  •••  REDEFINE  FLAgS  OF  CELLS  THAT  BECAME  PURE 

DO  1 288  K-2  ,KMAX 
IF  4 MFLAG ( K  1  .GE«0  1  GO  TO  1288 
MKc-MFLAGIKl-lOU 
MF|.AG(K)=0 
RHO{NV0l0,MK)a0. 

00  1  280  N*l  i  NNAT 

1 F 4 RHO I N ,MK 1 .GT.O* )  MFLAG(K)»N 
RHO 4  N, MK >=0. 

XMA5S  <  N.MKIbQ.  ■■■.-• 

SIE(N.mk)*0. 

1280  CONTINUE 

IF(MFLAttlK) .GT.O)  GO  TO  1285 
AMX<K 1*0. 

A  I  X  4  K I =0. 

'  U  4  K  )  =  0  • 

V  4  F  ) *0. 

1'265  CONTINUE 

RHO  (  1  ,  HK  1  =.-  l  . 

-128  8  CONTINUE 

c  .4.  PRINT  SYMBOLIC  MAP  OF  Ar.TlVt  GRID  DISPLAYING 

c  THE  LOCATION  OF  THE  MATERIAL  P « C K A GES 4 NUMbE K E D  CELl5> 

C  ;  A  N  (0  THE  MIXED  CELLS  (LABELED  'MM. 
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*M4«2 

8883 

8*488 

8885 

8886 
8887 
*4  <4  88 
*4*489 
*4890 
889  1 

8892 

8893 
8898 

8895 

8896 

8897 

8898 

8899 
8500 
850  1 

8502 

8503 
8508 
8505 

8504 

8507 

8508 

8509 

8510 
85  1  1 
85  12 
85  1  3 
8518 

85  IS 

86  1  6 
85  1  7 
85  1  8 
85  19 
8520 

852  I 

8522 

8523 
8528 

8625 

8626 

8527 

8528 

8529 

8530 

853  1 
8  5  3  2 
8533 
8538 
8535 


|F<NPR  JnT.ES).0  «AND»NC.6T«0|  CO  TO  1508 
KRITCI6, 1370) 
l  OL  •  1  t 
JDL-I2 

1F04C.GT.0  0  GO  TO  1  SC  1 
1DL-MIN0I  1MAX,5*»> 

JDL-JMAX 


1501  J*  JUL 

1502  DO  1508  1-1  ,  10L 
PR1  1  laSYMBOKA) 

K-l J-l  ) •  IMAX+l  +  l 
MFK  -  PFtAClK 1 

1FU1FK.IT.  1001  PR(l)  «  SYMBOL  (  MFK  ) 

IF(MFK.EQ.O)  PKtt)  ■  SYMBOL  ( 6 1 
IF1MFK.GT.1001  PR(l)  ■  SYMBOL  1 7  ) 

1508  CONTINUE 
C 

IFlMOol  J.51 .NE.OI  60  TO  1505 
6RITE16, 13801  J,  (PR (1)  • 1 « 1  , !0L > 

GO  TO  1506 

1505  *R  I  TE  1  6 , 1 390  1  (  P  R  (  t  1  ,  I  «  1  ,  I  D  L  > 

1506  J-J-l 

IF(J.EQ.O)  GO  TO  1607 
GO  TO  1502 
1607  PR (  1  )  «SYM80l { p | 

H1RITE14,  1380)  J,  <PH<  1  >  ,  1-1  ,  IDL) 

»R  1  TE 1 6  ,  1 800 )  (  1  ,  1 >  0 . 10L.S) 

1508  CONTINUE 

C  .*•  ETH  -  THEORETICAL  ENERGY  SUM,  USED  IN  ED  t  T  FOR 

C  ENERGY  CHECK . 

c  •••  EZPH2  -  ENERGY  SET  TO  ZERO  IN  ph2  SINCE  TIME-0. 

C  «»•  SOME  -  SUM  OF  THE  ENERGY  FLUXES  IGNORED  ON  THIS  CYCLE. 

ETH-ETH-SUHe  , 

EZPH2-EZPH2-SU8E 

RETURN 


1290  FORMAT  (5H  NEG . I  3 » 1 8 , 8 H  » 1  PE  1 8 . 7  * 4H  DELM-  .  I  PE l 8 . 7 . 6h  BOT-.lPE 

118. 7, 7 h  LEFT-, IPEl 8.7 .6h  T0P»,1PC18.7,5m  RT-.lPE18.7l 

1300  FORMAT  (5h  1-  1 3 , 6  X ,5H  J=  13.6X.9H  ENERgT"1PE15,8) 

1310  FORMAT  1 7H  A MP Y- 1  PE  1 5 . 0 , 6X i 6H  A MM P *  1  PE  I  5 . B  ,  6 X  ■  6 H  A MH Y ■  1  P E 1 5 • B , 9 h 
|GAMC(J)«1PE|S.3J  | 

1  320  FORMAT  1 7 H  0ELeT-lPE15.816X.6HDELER“lpE15.B,ix,6H0ELE9“IPEl5.b,9H 
1  S I GC  t  J 1 » 1  PE  I  5, 3 ) 


1  330  FORMAT  1  8  H  PH2.218.8H  M- , 1 P E 1 5 . 8 , 6 H  S  I  E » , 1 P E I  5 . 8 . 8 H  U-.jPElB.e. 

1 8H  V- , | PE  15.8, I HH  SIE  SET  TO  ZERO) 

1  380  FORMAT  1  8  H  PH?,2|8,8H  M- ,  1  PE  i  5 . 8 , 6H  S  I  E*  ,  l'PF  1  5  .  H  ,  8  H  U-,|PE|5.8, 

I  8 H  V-, |PE15.8. 19H  CELL  LVAPoRaTkO) 

1350  FORMAT  (12«  ADJUST  FIUX.8H  M=  ,  I  P E  1  8 . 7 , 6 H  0ELm« , 1  PE | 8 • / , 6H  BOT-, 
11PE)8.7,7h  LFFT- ,  1PE  1  8.  7 ,6H  T  OP- ,  1  PE  1  8 . 7  ,  SH  l?T- ,  1  PE  1  8 . 7  I 
1  360  FORMAT  (12H  ADJUST  MASS , SH  M » , 1 P E I  8 . 7 , A H  0 EL M = , 1  PE  1 8 . 7 , 6H  B0T«, 
llPEt8.7,7H  LEFT-.  IPE18.7.6H  TOP- ,  I  PE  1 S . 7 ,5H  9T-.1PE18.7) 

13  70  FORMAT  I  1 H I  ,31)4  DISPLAY  OF  MIXED  A  Mr.  pl.'RL  CELL'S  ,  5X  ,  1  8HM  •  I1|XED  CELL 

l  sx , h 3M numeral  n  »  pure  cell  of  package  n  material//) 
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*(534 

<4537 

9538 

9539 
9590 
959  1 
9592 
9  59  3 
9599 
9595 
9S94 
*♦5^7 
9598 
9  5  9  9 

9550 

9551 
•*552 

9553 
955** 
9  5  5  S 

9554 
9557 

9559 
9569 

9560 
9541 
9562 
956  3 
9569 
9565 

9564 

9567 

9568 

9569 

9570 
95  7  1 

9572 

9573 
9679 

9575 

9576 

9577 
9579 

9579 

9580 
958  1 

9582 

9583 
9589 

9565 
9586 
958  7 

9588 

9589 


1380  FORMAT  (H0.2H  1,59*21 
1390  FORMAT  (10X.2H  1,59*2) 

1900  FORMAT  (112,10110//) 

1910  FORMAT  1/20H  MASS  LEAK  IN  COLUMN  ,  1 6 , 6H ,  ROW,  16) 

1  920  FORMAT  < 1 H 1  , 26HFREE  SURFACE  TRACERS  ADDED  // 

1  <6( !A,2X,FS.2.2X,F5,2)>> 

1  930  FORMAT  <  9H  Ph2, 219, 9h  N«,19,9H  M»  ,  I P E  1 S . 8 , 6 H  RMO ■ , 1  PE  1 5 , 8  * 

i  6H  sie»,iPei5.a,i9H  mass  evaporated) 

1990  FORMAT (69H  ERROR  CONOlT|ON-  MIXED  CELL  AT  TRANSMlTTjVE  BOTTOM  BOuN 
1DARY  I«,19,  9  H  J«,19,11H  MFLAG (K )*, I  9  )  . 

1950  FORMAT (  8  H  I.J.MFK.  314,  29H  ISOLATED  NESATIVE  MASS  -  Ph2) 

I860  FORMAT  (  /  9  H  PH7,219,MH  .\I«,I9,3H  HFLAG-.l9.6H  M  A  S  S«  ,  1  PE  1  6 . 8  , 

1  4H  S  I  E  «  ,  1  I' 1 1  6  .  8 , 2  1  H  NE  G  ,  MASS  EVAPORATED/) 

1  700  FORMAT ( 1 X  ,2 16 ,5X  ,  22HPURE  CELL  0 V E R E MP T 1 E 0 . ) 

■  END 

SUBROUTINE  P  H  3 

c  •••  COMPUTES  effects  of  devi atoric  and  hoop  stresses 

C  TO  UPDATE  CELL  VECOCfTlES  A NO  ENERGTeS. 

INCLUOE  COHnlM 
M«1 1*1 

C  •  •♦  CALCULATE  FACTOR  FOR  V AR I  ABLE  DT . 

c 

C 

ICV-1NT (CTCPH3 ) 

0N»0, 

DO  10  I»l  ,  ICY 
10  ON«ON  +  FtOAT (  I)  , 

c 

C  •••  LOOP  THROUGH  SUBCVCLES 

C 

DO  500  L JH" 1 , ICY 

DTF ACT-FLOAT ( tCY-LJwM ) /ON 

otstr»ot*otfact 

c  •••initialize  p  array 

00  1  8  K»  l  ,  K.MAX 
IP  P ( K 1 *0 • 

c  •••  define  pointers  used  for  storing  strain  rates 

C  THREE  rows  at  a  time, 

NKA»3 

NK  =  2  '  <  ■  - 

NK  B  •  1 

C  ••♦  CEFINE  STRAIN  RATES  FOR  FIRST  TWO  ROftS  OF  GRID. 

DO  30  J«  1  , 2 
NT* J* 1 
VFACT.l  ,0 

IFfJ.E9.-l  .AND.  CVIS.GE.C.)  VFA'CT-.l.O 
C 

DO  27  1.1,11 
K=( J-l  ) • 1MAX*  f ♦ 1 
I K= I ♦ l 

MFX  =MFL AG ( K  ) 

C  »*«  JHPN  MN  3»20.  MATERIAL  If,  CELL  IS  AM  f  DEAL  GAS.  SKIP  O^T. 

MNBaO 

IF  <  MFK  .1  T.  IOC  I  MMB«MaT(MFM 


87 


9590  IF  1  AMX  IK  »  .UE«C.  .OR.  MNe.E0.20)  60  TO  27 

9591  KA»K*]MAX 

9592  KB«K-IMAX 

9593  KR*  K ♦ t 

9599  KL«K-l 

9595  MEKA»MFLAG <KA  ) 

9596  MFKB«MFLAG<KB> 

9597  MFKS»MFLAG I KR ) 

9598  MFKL=MFLAG ( K U  )  • 

9599  UFACT-1,0 

9  6  0  0  C 

9601  *VSA«  1 .0/ (  .5«0X  (  1-1  I +0X  <  t  )♦  .  5«DX  U  +  i  |  1 

9602  C  ! 

‘♦<>03  . .  ADJUST  TERMS  IF  CELL  ON  RIGHT  IS  VOIO  CR  OUTSIDE  6HI0. 

9609  C  i 

9405  1F(AMXIKR).6T,0..ANd,|.LT.IMAXIG0  TO  21 

9606  4SX«| .0/1 ,5»(pX(  I-l  ).DX|  1  )  )  ) 

9607  KR»K 

RAO?  c  •••  ADJUST  TE9MS  if  cell  is  jn  axis  column. 

9609  21  lfll.GT.ll  GO  TO  22 

9610  »SX>| ,0/ ( 1 .5*0* ( I ) *.5*UX  12  I  ) 

9611  KL=K 

9612  UFACT.-1.0 

9613  GO  TO  23 

96  I  9  C 

^615  . . . .  ADJUST  TERMS  IF  CELL  ON  LEFT  IS  VOID. 

9616  C 

9617  22  IF ( AMX ( KL ) .GT ,0. ) GO  TO  23 

9618  ASXc  1 ,0/ (  ,5.  <  pM  1  )  *DX  (  1  M  >  >  >  . 

9619  KL«K 

9620  C 

9621  23  AST* 1 .0/ I . 5»Dy I J- I • +DY  l  J  )  ♦*5»DY  (  J+ l  I  ) 

9622  C 

9623  c»»» ••♦•••»•  ADJUST  TERMS  IF  CELL  ABOVE  IS  VOID  OR  OUTSIqE  GRID. 

9629  C 

9625  IF  t  AMX  I  K  A  )  «GT.O.  .  AND,  J.I.T.  JMAX  I  60  TO  29 

9626  *SY«l,0/(.5*(pVIJ-l|  +  0Y(jm 

9627  K  A  =  K 

9629  C  •••  ADJUST  TERMS  IF  CELL  IS  IN  BOTTOM  ROW  OF  gRIO. 

9627  29  IF(J.gT.I)  GO  TO  25 

9630  *SYM.O/<  i.5«DYU  >  +  .5*DY(2>) 

9631  KB  =  K 

9632  GO  TO  26 

9633  C 

9639  Ct»»****.*.«  ADJUST  TERMS  if  CELL  below  IS  void. 

9635  C 

9636  25  IF  1 AMX I KB J »GT .0 .  ) GO  TO  26 

9637  WSY«  1 .0/ I .5. (OY ( J) +0T ( J+ l  I  I) 

9638  K  B  s  K 

9639  C 

9690  26  DVODXo ( y ( KR ) - V ( KL )  ) ♦ WSX 

969|  DUCOXr(UlKR)-l'(Kl)«UFACT)**SX 

9692  OVCDY* 1 V  IK  A |-V (KbI *VF ACT >«A5Y 

9693  DDOOY*  (  U  I  K  A  1 -li  (  KB  I  I  ««SY 
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•*«,**«♦ 

UC»»U<K|/(X(  I  (  ♦  X  <  |-|  )  1  •  2  « 

9695 

TH03  «  (CUODX  ♦  0V00Y  ♦  00X1/3. 

9696 

E 22 1 1 K . NT  J  »  DVOOY  -  TH03 

9697 

EKRIIK.NT)  *  DUODX  -  TH03 

969ft 

EP2CTK.NTI  «  (GOODY  ♦  0V0DXI/2. 

9699 

527  1  IK, NT  1  «  S  T  P  S  2  2  U) 

9650 

SR  PI  1K,N,TI»STPSRP<K) 

•*65  1 

SR7 <  I  K  ,nT > *STFSR7 (K ) 

9652 

27 

CONTINUE 

9653 

c 

*♦*  DEFINE  STRAIN  RATES  FOR  CELLS  IN  DUMMY  COLUMN  LEFT  OF 

9659 

c 

AXIS. 

9655 

E 7 2 ( 1  ,NT  1  «  F  72 ( 2 .NT  | 

9654 

ERRI 1 ,NT1  «  £PF(2,NT) 

9652 

ER2  t  1  ,NT)  *  I R2  <7. NT)  5 

965S 

S22 1 1 ,NT 1 *522 ( 2 ,nT 1 

9659 

SKR<  1  ,Nt  )*SPI>  (2. NT  1 

9660 

SR2 (  1  ,NT 1 *Sr7 ( 2 .NT ) 

966  1 

30 

CONT I  H  U  E 

9662 

c 

••*  define  strain  rates  for  cells  in  dummy  Row  below  grid. 

9663 

DO  3  5  I K  *  1  • M 

9669 

F.  7  7  I  I X  «  1  I  *  E72fJK»2) 

9665 

EPR  c  If  .  I  I  *  ERR  1  IK .21 

9666 

E  R  2  C  I K  ,  |  I  *  F  R  2  1  I  K  i  2  1 

9667 

S2  2 ( IK , 1  I *SZZ (  IK , 2 1 

9668 

SRR (  IK  .  1  )*SRR(  IK  ,2) 

9669 

S  R  7  I  1  K  1  1  I  *  S  P  7  (  I  K  ,  2  I 

9670 

35 

CONT I  NOE 

9671 

c* 

96  7  2 

c 

9673 

c 

.*•  CONFUTE  NEY  CELL-CENTERED  STRESSES  -  MOVING  ACROSS 

9679 

t 

ROY  S  ... 

9675 

c 

9676 

c* 

9677 

do  i on  j* i » i i 

96  78 

K*  <  J-  l  I  •  1  MAX  *  2 

9679 

00  50  1  *  1  • 1  I 

9660 

MFKbMfLaG(K) 

9  6  6  1 

1  K  *  I  ♦  I 

9682 

c 

•  ••  WHEN  MnB*2C,  MATERIAL  IN  CELL  IS  AN  IDEAL  GAS,  SKIP  OuT 

96  6  3 

M  M 1  *  0 

9689 

I  F  (  NF K . LT . i OC )  MN8*MATIMFK) 

9685 

IF (  Ah>  ( K  I  • LE .0.  .OR.  MN8.E6.20)  GO  TO  95 

9686 

call  stpng 

9667 

ST  FE  NO* V  5 

9688 

36 

IF  1 STPENO.LE .C .  I  00  TO  95 

9689 

TKC  *  2 • • ST  RF ►  G»  •  2 

9690 

c 

•  *»  Cf  TERHlNF  POSITION  OF  MaTFRIAL  WHICH  AIll  Bf 

969  1 

t 

AT  cell  CENTER  AFTER  PH2, 

9692 

PXT  *  -UlK)«tT 

9693 

DYT  *  - V 1 K I  * 0 T 

969  9 

A  D  >  T  *  A  0  5  (  0  >  T  I 

9695 

A  DVT  c  AfiMr-YT) 

9fc96 

t 

•  *‘  (-CP  I  ZONT  Al.  ,  V  F  ft  T  I  C  AL  ,■  o  1  AGONAL  WEIGHTING  FACTORS  (AREAS) 

9697 

Si  K.  =  (  D  X  (  1  I  -  ID  *  T  )  «  (  0  Y  (  0  )  -  A  C  Y  T  ) 
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9fc9P 

*Kh  ■  ADXT*ICV( Jl-ADYT) 

9  6  99 

r.KV  -  AOVT-II  XI  M-APXT) 

9700 

*KP  »  AOXT»APyT  i 

9  7  U  1 

A'SUM  c  WK  V-XH  ♦  WAV  ♦  MCI) 

9702 

c 

•  dettraine  indices  of  cells  used  to  calculate 

9703 

c 

IMURFOLaTED  VALUES  OF  STRAIN  RaTES  ADD  STRESSES 

9709 

Ah s  »  r.-l 

97CS 

Ull  *  IK-1 

97C* 

1  F  1 1) X T  .  L T  .  0 .  1  CC  TO  9 C 

9707 

r  h  s  «  *  ♦  i 

9  7  OP 

AHf  «  1  K 4  1 

9709 

c 

97  10 

MO- 

AV$*A-IMAX 

97  11 

K  V  E  =  M  K  B 

97  12 

iriDXT.LT.O.  I  (.0  TO  92 

97  13 

A  V  S  E  K+IMAX 

97  19 

A  V  f  «  NKA 

97  15 

c 

97  16 

92 

ADS  «  AVS-1 

97  1  7 

lFlr.XT.GT. 0.1  AOS  «  KVSfl 

97  l  P 

c 

*•*  RFrFFINE  INDICES  IF  NEIGHBOR  CELLS  ARE  EmF>TT, 

97  19 

c 

OUTS  IDF  GRID.  UR  ARE  MIXED. 

9720 

0  F  It  ■  MFLAG1AN5) 

972  1 

MFV  *  MfLAG(AVS) 

9722 

IF(  AMX  (KHSI  .LF  .0,  .0R.A1FH.EC  .2D.()R.KhE-l  ,6T  ,  INAX  IKHE-IK 

9  7  23 

IF ( am/ ( KVS )  .LT  .0.  .0P.I1FV .EQ.20.0R.KVS.6T.KMAX IKVEbNK 

9729 

c 

•••  CORRECT  for  CCt.VtCT  1  ON  hy  interpolating  STRAINS 

9775 

c 

Ai  r  STRESSES  AT  f'Ol  NT  (OxT  ,  OrT  )  . 

9726 

E  2  Z  1 11 T  >  (HK»FZZ(  IK.NK)  4  A  K  H  •  E  Z  Z  (  K  HE  ,  NK  )  *  WK  V  *E  Z  l  (  1  K  •  K  V  E  ) 

9727 

: 

1  l.KO*F  ZZ  (  KliE  ,  A  Vt  1  I /Y  SUM 

9  72  0 

tRRINT  b  (  Vi  a  »  f  K  R  1  j  K  ,  N  K  )  4  *  K  H  •  E  R  R  (  K  HE  .  NK  1  4  W*  V  »ER  R  (  I  K  .  K  V  E  > 

9779 

1  if. K n •  F K 9  (  Kill  ,a  Vf. )  ) /r.sUM 

9  7  30 

E  R  7  1  M  T  >  ( I.K»F  R2  1]  A  ,NK  I  4  *•'  Kll  •  t  R  Z  <  K  HE  .  N  K  1  4  »K  V  •  E RZ  1  I  A  »  K  V E  ) 

973  1 

1  »  i:p*FR2  (  KHE  ,A  V  r  J  )  /  A  SUM 

9732 

c 

9  733 

SZrillT  b  <  0  A  •  S  7  Z  1  I  A  ,  I'A  1  4  A  Ah4S7Z  (A  HE  .NX)  +  VIA  V  •  S  Z  2  (1  A  1  K  Y  £  ) 

9739 

i 

1  '»  r.O*SZZ  1  Are  * AV{.  1  1 /V.SUM 

9735 

SRI.  IN  T  e  ( 1»K  •  SRI' 1  1  A  ,  111  )  4  *KH*SRR(KHE,MA)  ♦  Vt  K  V  •  S  K  R  I  I  A  .  K  V  £  > 

9  7  36 

1  l.kl»»SRR  (  KHE  iAVL  )  1  ZWSUM 

973  7 

S  R  7  I  ll  T  s  1 1<  A.  4  SR 7  1  I  K  ,  1.  K)  ♦  V.  A  H  »  S  R  7 .  (  A  Hf  .  UK  1  4  WKVaSRZCJK.KVeI 

9739 

1  Uk  L'  •  5R2  <  A  HE  ,  A  V  f.  1  ) /«  SUM 

9739 

c 

»•*  CA1.CUI.ATe  N  Eft  STRAINS  AND  STRESSES 

9  7  9  0 

IF  1  MFa.C.T.  lfio  ICO  !0  93  * 

979  1 

»S/.*Rt*U(MFA  ) 

9792 

GO  TO  S5 

979  3 

*3 

MAF=MrK-ieo 

9/99 

t.  5  A  «  0  . 

9  7  95 

V  C  f  L  L  =  T  A  U  (  1  )  •  r.  Y  (  J  1 

9796 

DO  5  9  M  M  »  1  1 11 1.  A  T 

979  7 

IF  (  AN/SS  (  '  M.Hk-F  1  .1  t  .  C  .  1  00  TO  S  9 

9  79  9 

V  0 1 . 1  =  A  N  A  S  S  (  >t  M  ,  N 1.  E  1  /  (  R  H  0  <  N  l*;  .  M  A  F  )  «  V  C  F  L  L  1 

9  7  9  9 

l.  S  A  s  “1 S  A  4  R 1)  U  (  UN  1  •  V  0  L  M 

9  7  0  0 

COf.TIliUE 

9  7  5  1 

r»  S 

s  S  *  2  •  4  •.  5  A  »  0  T  5  T  * 

90 


9752 

9753 
975** 
*(755 
9  756 

9757 

9758 

9  759 
9  7  60 
**76  1 
<♦762 
<♦76  3 
9769 
<*765 
**766 
<*767 
9768 
<*769 
<*770 
<*77  1 
<*77  2 
<*773 

5779 

9775 

9776 
977  7 
9779 

9779 

9780 
97H  t 

9782 

9783 
9789 
9785 

8  786 

9  787 
9  7  88 

9789 

9790 
979  1 
4  792 
9793 
9  7  99 
9795 
97  9  6 
9797 
9  7  9« 

9799 

9800 
990  1 
9  6  0  2 
990  3 
9  9  09 
9  8.0  5 


STHSZZ<K)  •  SZZ1NT  ♦  EZZINT.HS 

s t f» s k r» i k )  «  srrint  ♦  eprint*iis 

S7KSN7U)  ■  5  R  2  I  H  T  ♦  ff?ZINT»W5 

c 

C  •••  HAS  Y1EL0  POINT  BEEN  ExrEtOEO 

C  ' 

TK1  e(STRSZZ{K)»»2  ♦  STRSKR  I  K >  •  ♦ 2  ♦  STPSRZm»»2  + 

1  5  T  R  5  Z  Z  1  K  )*STR'SKW(K  )  )  •  2  • 

IFtTXl.GT.TKOI  60  TO  991 

IF  * TK t  .Ll.TKO* I .K-061  00  TO  95 

GO  TO  SO 

c  Ptnl'CK  STRESSES 

U9I  W S  •  SORT ( T  K  0  /  T  K  1 1 

STRSZZIk)  *  STRSZZ  <  K  )  **.S 
s trsrr ( K  I  =  STRSRRTKI*pS 
STKSRZUl  *  STPS«Z(KI»«S 
60  TO  50 
9S  STRSZZ ( K 1 *0 . 

ST**SRt*  (  K  1  =0. 

STIfSRZ  (  K  J  =0  • 

c 

C  *•«  END  OF  l-LOUP  FOR  r*E«  STRESSES 

C 

SO : K*K* I 
C 

c  •••  DEFINE  N  K  .  N  K  A  » N  K  B  FOR  NEXT  ROW. 

c  COMPUTE'  ANOTHER  ROW  Of  STRAIN  RATES. 

C 

1FU.EU.I21  GO  TO  100 

NKA»NKA+I  ’ 

NK  ■  NK+1 
NKH=NK8. I 

I F ( NKA .  GT .3)  OKA* l 
I F ( NK.6T • 3 )  NK* 1 
I  F  I  NKf*  .  GT  .  3  )  NE9=>  1 
I F 1 J ♦ 2 • G T  .  Jh A  X  1  GO  TO  100 

c  ...  QF  F I N  L  STRAIN  RATES  IN  THE  ROA  ABOVE  THE  NE*T  ONE  TO  »E 

C  CAL CULATED  < J*2» * 

K  K  *  *  J  ♦  l  )  •  I'M  A  X  ♦  2' 

00901=1.11 

MFKoMF  LAS  <  KK  > 

IK  = l* 1 

c  ...  *HFN  I1NB-22.  MATERIAL  IN  CELL  IS  An  lOEA|  GAS.  SKIP  OuT 

M  N  U  =  0  ’ 

IFIHFK.LT.100)  MCIB  =  MAT(MFK) 

IF ( aMX ( KK 1 • LE • o.  .OR.  MN8.E0.20I  GO  TO  85 

K  R  =  KK  + I 

irL  =  KK-  I 

Ke=KK- I  MAX 

KA=KK*IMAX 

•'IFF  A  =  ,‘IFl  AS  I  K  A  I 

KFK|)*nFL  AG  I  *'»  >  . 

MFK  R*MF  l.  AS  1  K  R  1 

HFKL  =  MFl.  All  <  K  I.  I 
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I 

I 


9806 

9807 
9  008 
9  81)9 
88in 
tai  i 

*48  1  2 
98  13 

98  |  9 

99  19 
98  16 
98  17 
9H  I  8 
98  t  9 
9  8  20 
992  1 

9022 

9023 
9829 

9825 

9826 

9827 
98  28 

9829 

9830 
983  1 

9832 

9833 
9«39 
9  8  3  9 

9836 

9837 
98  3H 
9839 
9  8  9.0 
989  1 

9892 

9893 
9899 
9899 
«R96 
909  7 
9690 
98  99 
9890 
989  1 

9892 

9893 
9899 
9  H  9  5 
9896 
989  7 
9898 
9  8  9  9 


c 

c 

c 

c 


c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 


c 


0F6CT«1,0 

6Sx«i  .0/ 1  .s»r>x  < !-)  > *nx  1 1  > +  .5*dx  ( i  + , )  > 

.........  ADJUST  TF.HHS  IF  CELL  ON  night  is  void  on  outside  grid, 

I 

IF ( ADX ( K» > »0T .0. . ANo. 1 ,LT . IHaX I  GO  TO  AQ 
».SX»l,Q/(.&«(pXlI-I)+|)X(|Ul 

kr  =  kk 

•••  ADJUST  TERMS  IF  CELL  IS  IN  AXis  COLUMN. 

60  IF  t 1 .GT.  1  )  GO  TO  62 

ftSXsl ,0/t 1 .5»DX< 1 >+.5*DX (21  ) 

KL=>KK 

UFACT.-i .0 
GO  TO  69 

•••***•«*  ADJUST  TERMS  IF  CELL  ON  LEfT  IS  VOID. 

62  1F<AMX(kL)«GT.C.)G0  TO  69  j 

MSXal,u/(.9«(nXtI)+oX(I*IJJ) 

kl»kk  ! 

. .  AOJUST  TERMS  IF  CELL  ABOVE  IS  VOID  OR  OUTSInE  GRID. 

69  I E ( AMX ( K A > «GT .0 . . AND . J.LT . JMAX ) GO  TO  66 

tvSYo  i .  o/  <  ,5«  ( nv  <  j*2 )  +  or  i  j»  i  > ) ) 

K  A  =  r.  K 

.........  ADJUST  TERMS  TE  CELL  QELOHl  IS  VOID. 

66  IF(  AHX  (Kill  .GT.O.  1G0  TO  70 

AST  b  i  ,  0  /  (  .  9.  ( |)Y  ( .1  +  2  )  ♦  n  Y  (  J*  j)  )  ) 

kh  =  kk 

70  CONTINUE 

DVO|>Vr  (  V  IK  A  )  -V  (EH  )  >  •  l.  S  V 
DUl.'Ur  *  I  U  I  K  »  I -<I  f  Kb  1  1  »*<S  V 
DVt)OX»(V(KR>-rVIKL)l«hSX 
0UODX  »  ( U ( KR )-U(VL 1 »UFACT 1 *WSX 
IlOX  «  U  (  KK  I  /  (  X  I  1  )  *X  I  1  -  1  )  )  *2  i 
T  H  0  3  b  (DUOOX  ♦  DVOtiV  +  UOXI/3.* 
f 721  I  K . N  K  A  I  =  OVODY  -  TH03 
ERRI  IR.  ,NKM  =  OUCTtX  -  TH03 
E  R  2  (  I  K  ,  N  K  A  I  =  IOUODY  *  DVOt.Xl/2. 

5 7  2  <  I  F.  i N K  A  1  ■  STR5Z2  <  KR  » 

SNK’l  IK  ,  N  K  A  I  =  STI’SMMKK  ) 

SR  7  (  T  A  *  nK  A  1  =  STPSK'Z  (  KR  ) 

GO  TO  90 

8  9  f  2  7  I  I  R  i  f  ( K  A  1  r  C  * 

ERR  M R  ,HKA l«C. 

EH/  I  1  R:  ,  NK  A  )>C. 

SZ7  U  R  ,  NK  A  »  b  C. 

SRR  I  | R  i  NR  A  )  .  b  P.  : 
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8660 

SRZ<  IX.NXAI  9  0. 

886  1 

C 

8662 

90 

K6  "icr  ♦  l 

HP*  3 

c 

•  OEF  1 NE  STRAIN  RATES  FOR  CELLS  IN  DUMMY  COLUMN  ON 

8668 

c 

LEFT  OF  AXIS. 

8665 

EZZ<1,NXA)b  E7Z12.NKA) 

8866 

F»R( 1  » N  X  A >■  f  PR  1 7  t  NX  A > 

HP  *7 

ERZ1  1  ,NKAI«  E  FZ  t  2  i  NX  A > 

8  8  6  0 

SZZ (  t  ,NKA  1  *S77 ( ? ,NX A ) 

98*9 

SPP (  1  ,  NXA I *SRP  t  ? , UKA 1 

*4670 

5PZI  1  ,NKA)*5P7(2,NNA) 

9  6  7  1 

c 

86  72 

c 

•  ••  END  OF  J-LCOP  FOR  NEW  STRESSES 

9673 

c 

8678 

too 

COMT I NUE 

8p7S 

c 

96  76 

c. 

8677 

c 

•••  CONFUTE  STRESSES  AT  CELL  BOUNDARIES.  THEN 

8e7  8 

c 

uPOAVf.  velocities. 

<16  79 

c* 

•  •  • 

*1  fi  0  C 

c 

96  P  1 

c 

DEFINE  POINTERS  USEO  FOR  STORING  OLD  VELOCITIES 

8  662 

c 

THREE  ROWS  AT  A  TIME, 

96  63 

NKa«3 

96  68 

NX  *  2 

966  6 

NXF-1 

8  P  6  A 

c 

*•»  STORE  OLD  VELOCITIES  OF  FIRST  TWO  ROWS. 

9867 

DO  200  nT«2,3 

8  f  e  8 

KK«(NT-2)*INAX*2 

9609 

00  190  IX  * 2,  K 

96  90 

UK  <  I  K  ,NT )  =  0  <  XX 1 

9691 

VX|JKtNT>»V(XKJ 

8692 

RHOCUK.NTJ  *  AHX  IKK  )/<TAUt  IK-ll*OV  (NT-t  )  ) 

9693 

1  90 

X  K  =  x  X  +  1 

9699 

c 

♦••DEFINE  VflOCITIES  FOR  CELLS  IN  COLUMN  ON  LEFT  of  AXIS 

9  8  9  S 

DM  1  ,  NT  1  =  -UK  t  2 .NT  > 

9896 

V X 1 1  .NT)  ■  VX  1  2  ,NT > 

9697 

RHOC  t 1  .  N  T }  b  RH0C ( 2 ,NT ) 

8698 

200 

CONTINUE 

8899 

c 

•  •*  D E FINE  VELOCITIES  FOR  CfLLS  IN  DUMMY  ROW  BELOW  GRID* 

8900 

VFACTc 1 . 

890  1 

IF 1 CVIS.OE .0. )  VFACTm-I . 

99r  2 

DO  210  I  X *  1  ,  N 

9  9  0  3 

UX I  |  X  ,  |  )  *  UK ( 1 X i 2  > 

9908 

V X  <  I  X  i  1  )  B  VX  (  I  X  ,  2  1  •  vr  ACT 

8  9  0  5 

RHCC  <  I  X  ,  1  )  =  FHC'C  1  I  X  ,  2  > 

8  9  06 

210 

CONTINUE 

8  9  0  7 

c 

8908 

DO  30C  J=  I  .  I 2 

8909 

X  *  f  .1"  1  1  •  I  M  A  X  ♦  2 

89  10 

c 

*••  SIT  TO  0.  STRESSES  AT  A x  I S ,  SNB  ,  STB  SE 1  TO  0.  WHEN 

89  11 

c 

F-  ARRAY  INITIALIZED. 

89  1  2 

SOIbC. 

8  c  !  J 

S’ t  =0 . 

93 


49  |  9 

C 

49|S 

00  250  1*1  i  1  1 

4  o  1  6 

X  K« I ♦ I 

49  1  7 

IKR»JK*t 

99 1  e 

MFXbMfLAGTK) 

99  1  9 

STP  »  0. 

99  20 

SNR  ■  0.  •  !• 

9  9  2  1 

SNT  ■  0. 

‘-922 

STT  -0. 

9973 

HOOP=0. 

992** 

00.1*0.  -  -j- 

<14  25 

iriPFK.fiT.JOC)  GO  TO  37 

592  6 

N*HAT  I  MFK  I 

9927 

IF ( A  MX  1 K ) •  LE  *  0 •  .OR.  H.EQ.20)  GO  Tn  230 

9928 

SOI  |  Da AMDM < MFK ) *HhOZ ( N I 

9929 

IF l RHOC ( IK  INK  1 .LT.SOL 10)  GO  TO  230 

9930 

GO  TO  2 1 1  | 

993  1 

37 

HKFoMFK-IOO 

9932 

1  F t Who ( NVO 1 0 .MKF )  «GT.  o.)  GO  TO  230 

9933 

00  36  MM*  |  1  MIA  T  ; 

9939 

IF(XMaSSIMH,MKFI .LE.O. I  GO  TO  38 

9  9  3  S 

N* MAT  1  MM  1 

9936 

SOLlO  =  AMOlKMM>.RHOZlM) 

993  7 

IFIRHOIMM.IIKF  )  .LT.SOtlOIGO  TO  230 

9938 

36 

CONTINUE 

9  4  39 

c 

4940 

c 

••*  COMPUTE  STRESSES  at  right  of  cell 

494  1 

c 

4942 

2!  1 

KR*K*J 

49  4  3 

IF  <  1  .F.Q.  1  MAX  )  GO  TO  212 

4944 

IFII.CO.lll  GO  TO  213 

4  9  4  5 

hfkrbdflag < k« )  I 

‘1946 

1 F  t  HFKR.GT • 100IG0  TO  41 

4947 

N=MaT(MKKR) 

4948 

1  F  1  AMX ( KR ) .LE.O.  .OR,  H.E0.20)  60  TO  213 

4949 

SOL  IO  =  AMDM( MFKR ) *RHOZ t U) 

4950 

!FIRHOCMKR.NK>.LT.SOLIO)GO  TO  2)3 

495  1 

60  TO  44 

4952 

4  1 

MFRKomFKR-IOO 

4  98  3 

IF ( RHO I NVO I D.MFRK  I  .GT.  0.)  GO  TO  J|3 

4984 

00  43  MM* 1 . NMAT  ' 

4955 

IF t XMASS1 MM.MfRK | .LE.O. )  GO  TO  43 

495* 

N “ M A  T ( MM ) 

4957 

SOl  I  D.AHiJM  (  MM  |  *RmOZ  <  N  ) 

4958  . 

1  F  <  RHO  1  M  1,’IFRK  )  .  uT.SOL  10)  GO  TO  2)3 

4959 

4  3 

CONTINUE 

4960 

44 

CONTINUE 

4  96  1 

c 

•••  normml  case.  i 

4962 

SNR  «  (STRSRR(K)  ♦  STWSHR(KH) )  •  .  5 

49*3 

STR  *  (STRiRZlKI  ♦  5 T R SR l i K» ) ) • . 5 

4  96  4 

GO  ro  2 1 4  1 

4965 

c 

•••  CELL  at  RIGHT  Gilo  HOUNoaRT,  1 

496* 

212 

SNR.STRSRR 1 K ) 

4967 

STR  =  STRSRZ  1  r  I 

94 


'♦969 

ETHCHG»(SN8*UIK)*STR«vtKll«l)ylJl»0TSTR 

9949 

IF  (  I6h,NE.  1  )ETHCHS«ETHCHG»r«OPl*Xm 

9970 

ET  H»ETH*E  TMCHS 

997  1 

IKK  •  IK 

9972 

GO  TO  219 

9973 

C 

•••  CELL  ON  RIGHT  EUPTY  OR  CONTAINS  FREE 

SURFACE,  or  is 

9979 

C 

UNOEHOENSE 

9975 

213 

SNRaO, 

9974 

ST R  =  0, 

9977 

c 

9  979 

c 

*♦•  COMMUTE  STRESSES  At  TOP  OF  CELL. 

9979 

c 

9990 

219 

KAoKMMaX 

998  1 

If< J.EO.JMAX)  GO  TO  215 

9992 

IF ( J.EO.  12  1  GO  TO  2 14 

9  783 

MFK AaMFLAG t K A ) 

9999 

IFf9FKA.Gr. 100160  To  94, 

9985 

N  =  MA  T ( MF<A  1 

9984 

1  F  (  AMX  (  K  M  «LE  .0  .  *0R.  N.E'J.20)  GO  TO  214 

9987 

SOL  1 DaAMOM ( MFK A  1 •RHOZ < N 1 

9998 

IFfRHOCf  IK.NKAl.LT.SOLlOIGO  TO  214 

9989 

GO  TO  93 

9990 

94 

MFAK«M1FKA-I00 

999  1 

IF  (  RHO  (  NVO  10  1  ME  A <  1  •  G.T  .  0.)  60  TO  2(4. 

9992 

DO  97  M  M  *  1  •  N.*t  A  T 

9993 

IFf  XMASSIMM.HFAJO  .LE.O.  1  GO  TO  9.7 

9999 

N=MAT ( MM  > 

9  9  95 

SOL  1 0»AMDM< MM » »RH02 I H 1 

9994 

I  F  1  HHOI  HI! ,  8F  AK  )  •  SOL  10)  GO  TO  216 

9997 

97 

CONTINUE 

9999 

98 

continue 

9999 

c 

•  « •  nornal'  case. 

5000 

SNT  a  (STRSZZ(K)  *  STRSZZfKAl >«*5  . 

5001 

STT  *  (STRSRZ(K)  ♦  STRSRZfKA) > ».5 

5002 

GO  TO  217 

5003 

c 

•  •  •  CELL  AT  TOP  GRIi)  ROUNDArY. 

5009 

2  1  S 

5NT  aSTRSZZ.  (  <  ) 

5005 

STT»STRSRZ  <  K 1 

5004 

E  T  H  *  £  T  H ♦ *  S  N  T ♦ 9  f  K 1 ♦ S  T  T  »  0 ( K ) ) • T  A  U ( | ) «0  T  S  T  R 

S00  7 

nka=nk 

5008 

GO  TO  2 1 7 

5009 

c 

•  ••  CELL  A  U  0  v  E  ErtPTV  OR  CONTAINS  FREE 

SURfACF  ON  15 

5010 

c 

UNdEROENSE 

SO  1  1 

214 

SNTaO. 

50  1  2 

S  T  T  a  0  . 

50  13 

c 

50  1  9 

c 

•••  COMPUTE  HOOP  STRESS. 

5015 

c 

5014 

2  1  7 

HOOP  ■  -(STRS7ZIK)  ♦  3Tn5RR(Kll, 

5017 

c 

50  l  a 

c 

•  DEFINE  STRESSES  AT  SOrToM  IF  CELL 

1  N 

First  ro<<  . 

50  1  9 

c 

5020 

IFIJ.QT. 1 >  GO  TO  220 

502  1 

SN8 (IK)  a  S  TRS ll ( K ) 

95 


5022 

5023 
50  2  H 
5  3  25 

5026 

5027 
5  02* 
5027 

5030 

5031 

5032 

5033 
5036 

5035 

5036 

5037 
5033 
50  37 
5  0  6  0 
5071 
506  2 
5063 
5066 

5065 

5066 
5  0  6  7 
5066 
506? 
5050 
50  5  1 
5052 
sr)53 

5056 

5055 

5056 

5057 

5058 

5059 
50ft0 
506  1 
5062 

5  0  6.3 
5066 

5065 

5066 

5067 
5066 
S06« 
5070 

6  0 '/  I 
5077 
5T7  3 
50  7  6 
5  r  7  5 


inCVIS.SC.OM  50  TO  220 
ST  Q  t  1  <  >  s  ST6S6ZU) 

ETh«ETH* ISNB< !< ) »V  t<  J*ST8«  J<7*U(K )  ) *T»U«1 »  *OTST« 

c 

C  COMPOTE  NE*«  VAU1CS  OF  U,  V,  SlE  FOR  CELL  K« 

c 

220  SNlX  a  S  '6  L  •  X  l  t-t  1 

*S  a  T >v 0 P  I  •  l> T  5 T 0 /  All X  (  K  ) 

OELO  -  WS«(OT<  JI*(SNR»X(  |»-SNLX)+TaUC  t»/TWOPl»(STT-«!TBUKn 

1  -  HO  OP  *0x1 l >*Dy  l  J)  ) 

STuX*STu«X(|-l) 

DELV  a  (V5*<  (SMT“SNb(  ik!  1  *  T  All  (  I  ) /TWOP  I  +  OY  I  J  )  •  (  STR»X  (  I  1  -STL*  •  > 

C 

UK  f  rn  UK (  I K  ,Mk  ) 

VKT  a  VK 1 f K ,  NK )  ; 

WS  a  TAUl  I  1 ».5»{  (  IUKT*UK(  16  ,NKa)  1»0TT  ♦  ( VK T ♦ V < (  I K  ,  N K A  )  )  *SN T » 
l  -  [ (UKT*U< ( IK »NKMll «STH( IKl  ♦  (  V  K  T  *  V  K  ( 1 K  >  N  K  b )  I • S  N  H ( 1K1  )  I 

C  .  i- 

W5*  a  P  IiJY«OY  (  01  •<  X  (  I  )  *  (  (»K  t  IKR,  NK)*UKT>.SNR  +  (VKIIKK,  NK>*VKT| 

1  «STR)  -  I  X ( I  -  1  l • (  (UK T  +  UK <  I  K*1  .  NK )  } »SNL:  ♦  (  VK T ♦ VK (1 K - 1 , NK  )  I 

2  »STL ) M 

c 

JFIIGM.NE.tMiO  TO  2221 
*SAaOTSTH/AMX|K1 

DEl.Uav»SA»  (OY  (  J  1  »(  SNK-SNU  )*TaU(  !>  *(  STT-STB  (  IK  >  I  > 

OELVa,(SA«  '  OY  (  J  1  »  (  STR-STL  I  +  T  AU(  I  )  •  !  SNT-SMB  (  IK  )  )  ) 

V»SA«,5.t>Y  (  J)  •  (  tl'K  I  IKK  ,NK  )  +OKT  )»SNR+(VKV1KR,NK)*VKT|«STK 
l-(  UK  (  IK  -  1  ,  NK  )  +IIKT  )  ‘Stll.-  (  VK  <  IK  -  l  ,  NK  )  +VKT  )  »STL  ) 

2221  WSRa I  US a*U5 I ‘OTSTR/ AMX ( K 1 

6sc  =  Of.i.u*  ( Ukt*oelu/2 .  l  +  r>tuv»  (  VKT  +  DFUV/2.  1 
OEl.l  a  WSH-WSC 
U(K1  a  U(K)+f)FLU 
V(K)  a  V(K)+OK|V 

TKI«(ST«SZZ(fc>**2  +  ST HSR K < K l • • 2  ♦  STR SR Z ( K 1 • « 2  + 

1  STR.S/Z  (K  |  aSTRSRH  (  K  )  )  »2. 

CALL  STRNC, 

S  T  RE  HCi  a '.IS 

221  TKC  =  2  •  *  S.l  RE  WG»  *2  - 

IF  (Ilf  K  .LT  .  lnu>  GO  To  225 

MKf  =  Mf K-  100 

VCf.l.  La  r  A  U  (  II  *0V  (  J  I  • 

C  0  2  2  2  M  H  a  1  ,  N  M  A  T 

IF ( XMaSS ( MH.MKf  I .LE.O. )  GO  To  222 
PV  =  1 .0/ ( KuC (MM ,HKF ) • VCCLL > 

SIC ( Mm iMKF I aSTE | MM i MKF I +PV*DELJ •  AM  x (K I 
|F(TF|a(|.+RGrl’5>.|,T.  TUII  GO  TO  222 
rtl'  (  MM  )  =  ft  H  (  MO  )  +  l'V«|iEL  I  a/,f;A  (  K  I  *  XU  A  55  (  MM,  MKF  I 

227  CONTINUE 
GO  TO  226 

7  75  (  F  (  TK  1  .  (  1  .  ■*  A  ore  5  1  .  I.  T.lKCI  CO  T  Ci  726 

C  Pt'-MIM  15  T  ri  l  TOTAL  PLASTIC  work  Of  MATERIAL  PACKAGE  K. 

C  RliOl'NP  IS  THt  TOTAL  ELASTIC  PLASTIC  *"OKK  OF  THE  6R|D. 

PL/'lMfK)  n  l‘i. ( t'F  K  I  ♦01"  L  1  "  A  h  X  (  K  ) 
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k  >;  >■ 


507* 

C 

5077 

b bound  ■  h  bound  ♦  del 1 •  amx ( K ) 

5.078 

C 

5079 

c 

•••  ceil  k  is  done,  save  stresses  for  cell  on 

5080 

c 

AND  CELL  /.HOVE. 

508  1 

c 

5082 

230 

CONTINUE 

5083 

c 

5088 

239 

SNL-SUR 

5085 

STL  «  $TR 

5086 

SNfll  IK)  ■>  SnT 

5087 

STO (  IF  1  =  5TT 

5088 

c 

508? 

IF  l  lNTFR.Nr.99 )  GO  TO  250 

Sn90 

E  “0  . 

509  1 

PW  =  C!  . 

50^2 

DO  290  LJC*2.KHAX 

5093 

E«E»ANX  (  LJD  )  *  (  .6.  (U  ( 1  JD  )  «»2*V  CLJO)  «»2  >  *A  I  X.(L  JD>  ) 

5098 

290 

COUTH. Ill 

5095 

UNITE  IA»‘I90>  I.J.E 

5096 

DO  296  LJ('«2  .  T  r 

5097 

UBaR=.5»  «uk  1L  JD  ,NK  »  ♦I.K  (LJO.NKA  )  ) 

5098 

VBAKb.5*<VK(L.JD,NK)*VK<LjD«NKA>1 

5099 

285 

E  *t-T AU ( L JD- 1  1 »  IUBAN»ST8 11 JD  »  »VBAR»SNB<L JD 1 >»OTST« 

5  1  00 

1  K  K  •=  I  K  ♦  1 

5  101 

DO  797  l.JO=lKr.!l 

5  102  - 

.Uft AK*  .'5 •  •  UK  (  L  JD  »  NK)  +  UK  (  L  Jl> «  NKB  )  ) 

5  103 

V8/.R®  .6*  <  VK  (  1  ..ID  ,NK  1  *VK  (  LJD  1  NKB  1) 

5109 

297 

E  =  E-TAU(LJD-1  1  •  (lie  AN  •STB  «L.'D  )  +VBAR*SNB  (LJD  1  »»nTSTR 

5105 

UB  AR*  .5*  (OKI  1 1:  ♦  L ,  M  K  1  ♦  0  F  (  1  K  .  N  K  >  1 

5  106 

VBAR=.6«  «  VK<  11  :•»  1  ,NK  )*VK  <  IK  .MO  > 

5  107 

£TucHG  =  f.Y  (  J  1  •  r  ||r.AK*SNL*VDAK»STL  I  •RTSTfi 

5  1  08 

IF  1  IC.M.Mi:.  1  )  ET*'Cl*G«t.THChG*T60P!  »X  (  1  1 

5  109 

E=r-ETHCHO 

6  110 

WRITE  16.9501  1 .J.E 

Sill 

P W  =  P P ♦ 0 E L  I • A N X  IK  1 

5  117 

WRITE  (6.950)  F'W 

6113 

c 

•  EN(!  OF  1-lDOP  FOR  NEW  VfLOCITIES 

5118 

c 

6115 

250 

K  «  K  ♦  1  * 

5116 

c 

5117 

c 

•  0  fflfE  UK  >  NK  A  .  NK  b  FOR  NfXT'  KOV, . 

5118 

c 

STORE  ANOTHER  ROV  or  OLD  VELOCITIES. 

5  119 

c 

5  12  0 

IFI.I.E0.I2)  on  TO  3  C  0 

5  12  1 

NKA  =  NM*l 

5  1  22 

NK  «  »|K*1 

5  123 

NKfi  =  NK  (i*  1 

5129 

IF  ( I.K  A  .  r,Y  .  3  1  MM  .  1 

5  I  76 

IKNK.61.3)  HK») 

5  126 

I  F  1  M.K  t;  .  r,T  .  .11  »KI-t 

5177 

1  F  1  J*.Z  .  f.T  .  UMAX  i  1.0  TO  30  c 

6  1  ?  8 

KKfi  I'J.  1  |  -  f  II A  K  +  7 

5  1  29 

DO  ?9f,  p.  =  2,0  . 
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Si  .10 
S  I  3  t 
SI  32 
S  1  3  3 
5131 
S  |  35 
SI  36 
S  l  3  7 
5  l  30 
5  1  39 
S  1  HO 
S  I  1  l 
S  1  1  2 
S  1  13 
S'l 1  1 
5115 
S  I  16 
5  117 
S  1  16 
S  1  19 

s  i  sn 

5  I  b  I 
S  |SZ 
S  I  S3 
5151 
S  155 
S  ISA 
5  157 
stsa 

5  159 
5  I  60 
S  1  A  1 
5162 
5  163 
5  161 
5165 
5  I  66 
5  |  6  7 
5160 
5  1  (.9 

5170 

5171 
51  72 
5  173 

5  I  71 
5175 
7  6 
77 
70 
79 
5  I  00 
5  10  1 
5  102 
5  113 


OK (  I K , NKA  1  ■  U I K  K )  j 

VK'IIK.NKA)  ■  V<Kr) 

RHUCIIK.NKAI  »  AMX(KK)/(TAO<  IK-l»*nVl J*2))  ; 

2  90  K  K  » f,  K  ♦  I 

OK  (  1  ,  UK  A  I  ■  UK  (  2  ,NK  A  1 
VK  (  1  ,  NK  A  »  »  VK  I  ?.  ,  NK  A  ) 

ROOttliNKA*  «  PHU  C  l ? , NK  A ) 

C 

c  •••  end  or  j-loqp  for  new  vfLOcities. 

r 

300  CONTINUE 

c 

c  END  OF  fine  SUBCYCLE. 

c  i 

500  CONTINUE 

C  INITIALIZE  P  ARRAY. 

DO  600  K  =  2  i  KMaX  I 

600  P  ( it  1  *  0  . 


RETURN 

c 

*<10  FORMAT  11T.2H|=I2,0X,2HJ=12.1X,2HE«1PE13.7) 

550  FORMAT  |1X,3HPW=IPE12.6) 

c 

END 

SUBROUTINE  PRflPilT 

c  •**  DEFINES  MtXEO  CELL  VARIABLES  FOR’  CELLS  TnaT  ARE 

C  ON  THE  BOUNDARY  OF  A  RECTANGULAR  PACKAGE.  CALLED 

C  FROM  SETUP  WHEN  GENERATING  A  PR08LFM. 

INCLUDE  COrtoIM 

c  assign  properties  to  boundary  cell  k  of  package  m. 

c  routine  called  uhen  setting  up  a;  Rectangular  package. 

IFlMFK.r.T.  i  no »  go  to  is  i 

MA*NO 

MFLAG(K)  =  100»N0 

H0=M0+1 

IF  (  NO.LE»UOXCL'»)  GU  TO  10  i 

NK-IO  ! 

n  r = 2  ; 

w  R I r  E ( 6 , 100) 

1  0  0  FORMAT  (  33  H  GENERATING  TOO  IIANY  MIXED  CELLS.) 

I  0  RHU (  1  ,MA ) ■». 

IF(MFK.E3*0)  go  TO  15 
RHO  (  MFK  ,MA  I  bHmO.1  U  (  UFK  > 

X  M  A  S  5  (  i  I F  K  »  M  A  )  =  A  ,N  X  (  K  i  ; 

5  1  E  t  N  F  K  ,  M  A  I  =  A  1  X  (  rC  ) 

15  0  M  0  (  M  ,  M  A  I  =  R  H  0  I  N  (  0  ) 

IFlM.EO.UVOlOl  RHO  ( >1  ,!Ul  *  1 .0 

RETURN 

END 

SUBROUTINE  RF.70UE 

. . *  - . i  *  •  ■ . .  • 

C  SUBROUTINE  RETONE  REZONES  The  grid*  if  If.XTXal  ftNO  IHAX  IS  AM 

C  EYEN  NUMBER,  THC  GRID  is  RLZONEO  IN  The  X  DIRECTION.  IF  JEXTr*l 

c  and  jmax  i  s  an  fyln  nu.-Kir..’! ,  the  grim  is  rezonfd  in  the  v  direction. 


V 


98. 


,w 


SUM 
5  1  rtS 
519* 
SI  87 
5  I  art 
5  I  99 
5190 
5  I  9  1 

5192 

5193 

51  99 
5195 
5  196 
5  197. 
5  198 
5  1  99 
5200 
520  1 
520  2 
520-3 

5  2  0  9 
5205 
570* 
5707 
5208 
5709 
57  10 

52  11 
52  12 
52  13 
52  1  9 
5215 
52  1  6 

57  17 
5  7  19 
52  1  9 
5720 

522  1 

5222 

5223 
5229 
5225 
572* 
5777 
5  2  2  * 
5229 
5730 

523  1 

5732 

5733 
5239 
5  7  35 
523* 
5237 


INCLUDE  COMO  I H 

,  WRITE!  6, 101  1C,  lE'CTX.JEXrT 

,  10  FORMAT!//, SX.'REZJNC  CAllEO  ON  C  7  CLE  •  .  1  5 , 5X  ,  •  |  Ex  T  X  «  •  .  I  2  » 

ISX, * JE XT  y  *• ,12,/) 

IF t  1EXTX.E0. O.AMJ. JC X T T . E 0 • 0 » RETUPN 

£••••••••  •  ••••••••••**  *  *••*••  *  **••*• 

C  ZERO  THE  PRESSURE  ARRAT. 

C  •  •  ♦  •  . . .  ...  4  •  •  . . *  • 

on  20  K » 1  ,<MAX 
20  P(k)an. 

iFHEXTX.C'l.Qla.l  TO  173 
N  I  H  A  X  =  I  H  A  X  /  2 

IF  (■  2  •  N  I  M  A  X  •  IQ  .  I  MAX  >50  To  90 

. . .  •  *.*  ‘  4  *  *****  • 

c  ERROR  ro'JNO..  1E<TX.|  auT  IMA*  NOT  EVEN.  GRID  NOT  RpZONED. 

C  •••«*••••«••»**•  * . .  ... 

*R i re i * , »o» i max 

30  r OHMAT ( 5* » *  1 «A X  a •  ,19,*  WHICH  IS  NOT  AN  EVEN  NUMBER.  fHE  GRID  WAS 
1  NOT  UEZONEO  IN  TtlE  X  DIRECTION.*! 

GO  TO  170 

. . . . . . 

C  GRID  TO  BE  RE70NEU  IN  *  DIRECTION. 

. . . . • 

90  N  I  HaX  1  =N  MAX*  I 

C  •  •  . . ♦  • . 

c  redefine  the  x  coordinates  of  the  tracers. 

. . . . . . 

DO  *5  NO  1  , MVO 1 n 
NP=NMP in) 

I  F  (  N  p  .  L  E  .  0  1  f,  0  T  0  6  5 
DO  60  Ms  1  i  NP 
IMNT(TXIN,M>> 

IF! 1 .UT. IMAX.ANO. IVARDX.CQ. 1 IGO  TO  50 
T  X  (  n  ,  M  1  ■  .  5  *  T  X  I  N  •  M  »  .  . 

GO  TO  *0 

60  rX.N»T>  i  H,H  >  -float  I  I  > 

J  =  I  -  2  »  (  I  /  2  > 

L  *>  1  -  J  ♦  1 

TX  t  N ,M ) S .5* FLOAT (  I  “  J  >  ♦  I TXH*OX I  1 ♦ 1  1. FLOAT (J) »DX  1  I  I  )/(OX(LJ«0X(L+l  )  I 
AD  CONTINUE  \ 

*6  C 0 NT  I  OLE 

M**  <  I N  A  X / ?♦ 1  )•  (J MAX/2+1  ) 

...  00  70  .  Mb  1  ,  IIP  ..  ■  ■  ■  ... 

I  ■  1  N  T  I  X  P  I  H  !  ) 

IFII.LT.  IN  AX  .AMI'-.  IVAKDX.tlv.il  GO  TO  68 
XP!MI  =  .5*XP(it) 

60  TO  7(1 

6 H  A P H  =  X  N I H l-K  LCaT  I  1  ) 

J= !-?• t  1/2) 

L*I*J*I 

XP  (  M  )s,  5  »  FLOAT  '  I  >  ♦  (  >!  H*  t'X  !  J  +  1)  .FI  OAT  !  J  >  «DX  (  I  H  /  1  OX  !  L  !  +  DX  !  L+  I  I  ) 

70  C UT.  T  !  I.U! 
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S23B 

C 

FIND  THE  BOTTOM  OF  THF  BOTTOM  PACKAGE  WHICH  EXTENDS  OUT  OF 

THE  OR  I D » 

52  39 

c 

«  • 

5280 

YMIN-FLOAT  l  jhax-u 

528  1 

lF(MBBfl.tE«0ir,0  TO  7A  ' 

6782 

CO  78 

** 

57*t3 

M0«MF AC ( MBBB  > 

52*15 

IF  IMP.lE.OlGC  TO  78 

6255 

DO  72  J«1 ,Mp 

5  2  5  A 

!F(PACTH,J|.LT,YMlN)YMlN«PAClf<I,J) 

5257 

72 

CONTINUE  ! 

5258 

78 

CONTINUE 

5289 

c 

•  • 

5750 

c 

STORf  cell  PROPERTIES  at  RIGHT  EDGE  OF  OLD  GRjO  AMD  ABOVE 

•  .... 

575  l 

c 

THIN  so  THAT  THIY  CAN  BE  USED  FOR  FILLING  THE  NEW  AREA » 

5752 

c 

♦  • 

5263 

76 

DO  78  Jal.JMAX 

5755 

MFGRE2(j1«0 

5765 

RE2ANA(j!«0. 

5  75  A 

78 

RE2AIMJJ.0. 

.  _ _ 

5257 

JYM I N« I  NT  I Ym in) Li 

5258 

1  E<  JYn  1  n  .(.E  ,  JNAX  |  GO  TO  90 

5269 

DO  88  JbJYHIN,  JMAX 

6  7  AO 

K  *  J»  I  F!  A  X  »  l 

6  2  A  1 

MFA  <=RE  L  AG  (  K  ) 

5242 

MFGRE7 ( Jl»FFK 

6263 

IF(MFK,lE,C)GO  TO  89 

5765 

RE2 AHX ( J) =AMX (K ) / 1 TaU ( IMAX ) »OYI J) ) 

6245 

IFImfk.gT* lOGIGO  TO  8C 

5  2  A  A 

RE2 a  1  X ( jl»SSl FN( MFK ) 

5267 

GO  TO  68 

6248 

BO 

MFF.Mfk-ICO 

5249 

DO  82  he  1  ,NMAT 

5270 

RE2XMS(N,JlaXMASS(N,MFR|/AMX<|Cl 

S  7  7  1 

RE2S1E(N.wI«C. 

5272 

if  (SIFIN.PFk) .GT.O. 1PE2SIEIN,J)«SS|EN«N) 

5273 

REZRHO IN,u) bRHOIN.MFKI 

5275 

82 

RE2  A  I  X  (  j  )  «Re7  A  I  X  (  j  )  ♦XR  ASS  (  N  .MFK  1  ARE  ZSI  E  (  N  ,  J) 

6275 

KE2A  I  X  1  J  IbREZA  l  XI  Jl/AP.X<KI  ! 

6776 

REZRMO«NVO)o,J>*RHO|NVDIO,MFk> 

5777 

88 

CONTINUE 

5278 

c 

•  * 

5279 

c 

C OF  PRES  The  CLC  c-ric  in  x  direction  by  combining  Pairs  of 

CELLS. 

5  2  80 

c 

•  • 

676  1 

90 

DO  1 00  J= I  1 jMa  X 

5282 

00  100  I « 1  INI MA  X 

578  3 

K*  C  J- J  I  •  IM.AX  ♦  I  n 

5265 

L= ( J-T  )  •  |  MA  x*2«  I  j 

6285 

M=L*1  1 

5284 

CALL  COMPRS(L)  1 

5787 

i  rc 

COM  1 F  Uf  ■  1 

5  7  £■  R 

c 

•  ♦ 

5789 

c 

REOEF  INE  X ,  DX ,  AND  TaU 

5790 

c 

•  * 

5291 

0  0  [  I  c  I  =  1  .  N  I  **  A  X 

1 


100 


J 

w- 


S 


5292 

5293 

5299 
529S 
6296 
5  2  9  7 
5298 
6299 

5300 

5301 

5302 
6303 

5309 
53C6 
5306 

530  7 
5308 
53  09 

5310 

531  I 
53  1  2 
53  13 
63  1  9 
5315 
63  16 
5317 
53  1  8 

5319 

5320 

5321 

5322 

5323 

5329 

5325 

5326 

5327 

5328 
6329 

5330 
533  1 

5332 

5333 
5339 
5335 
533  6 
5337 
6338 
5339 
6390 
5391 

5  3 ‘<2 

6  3  9  3 
5  3"  9 
5366 


i io  x*<  n»xi2»i  i 

DO  1 20  1-NlHAXl ,JMAX 
120  X( I I-2.-X | l-l )-K (1-2) 

«  5-C. 

00  130  l>lithAX 
OX (  1  )-X (  I  1-6S 

TAU  (  1  )  «p  1L-Y*  (  X  (I)  ••2-*S«*S  > 

IF ( JGM.EO* 1 ) T AU ( 1 1 *DX { It 
1 30  WS-X  I  1  ) 

C  ♦  ®  «  . . . 

C  FILL  Thf  lilt  AREA  *|TH  THE  PROPERTIES  SAVED  ABOVE,. 

. . . . 

MO-O 
C  TC  * 0  . 

DO  1 6C  J= 1  .  JMAX 

DO  1 50  I-NlMAX  1  ,  1HAX 

K«  (  J-  1  1  •  I'll  AX*  I  *'l 

M F L  A G  (  K  1  *  NF G R C 2  (  J  I 

AHX I K ) bREZAHX I J > *1 AU (1 > *DY I J> 

AlX(KJaRE7AlX(J> 

U  t  K  )  =  0  » 

V  C  K  I  ■  0  » 

IF <HFLAg<K » .LT. ICOI&O  To  150 
CALL  NtYMIX 
MF(C»HfLaGIK)“1C0 
00  190  H* 1 »NMAl 
RHOIN.MFKI-RPZRHOIN,  Jl 
SIE  (N,MFIC  )  =RF.75I  C  (  M  ,  Jl 
|1(1  XMaS51N,HFMoRE2XMS(N,J)*aHX(K1 
RH0(NVC|D.HFK)*fif2R»,0«NV0|D,J) 

1  50  CONT  I  MIC  ' 

C  *  »  *  *  •  •  ♦  •  •  •  •  •  •  *  •  •  *  .  •  •  *  *  •  •  •  •  •  *  •  •  *  *  * 

C  UPDATE  the  TOTAL  lHf CRITICAL  ENERGY  AMO  ACTIVE  GRID  COUNTER* 

. . . . . 

DO  1  60  J=  1  t  JM  A  > 

00  160  t  »N  f  MAX  1  •  I  M  A  X 

K‘ ( J- 1  1 • I  MAX*  T ♦  1 
160  E  T H * E T  M  + AMX  <  K ( • A  J  X  t  K 1 
11-11/2 

. . . 

C  GRID  HAS  6EEN  RFZONfC  IN  THE  X  DIRECTION. 

C  . . . . *  »  *  *  •  •  *  *  • 

170  I  F  <  JEXTY  .  EN.  0  I  Pf  TURf. 

NJMAXa JMAX/2 

I  F  (  2*6  JHA  X  .EC,  .  JMA  X  I  GO  TO  1  90 

. . . . 

c  •••••*•*  *  *♦•••••••••««•••***•**•*•• 

C  FRRCR  EOUNIi.  JtATYal  HUt  JMAX  DOT  EVEN.  GRID  NOT  rjEZONED* 

C  •  . . . 

It  RI  TC  1  6 , 1  CO  »  JMA'A 

| nri  FORMAT (5X  ,• JH A  X  = •  ill,'  *m!CH  |S  NOT  AN  EVEN  NUrEEK.  THE  uRIo  "AS 
1  NOT  KEZOMEP  111  Till  Y  PI  iiCCJ  1 DN  •  ’  > 

RETURN 

c». 
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6396 

6397 
5399 
5399 
*■350 
635  t 
6  3  S  2 
5363 
5  3  5  9 
6355 
S356 
5367 
5356 
5359 
53*0 
536  l 

5362 

5363 

5  369 

5365 

5366 

5367 

536  6 

5369 

5370 

537  1 

5372 

5373 
5379 

5375 

5376 

5377 

6  3  7  fl 
5379 

53^0 
5  3  9  1 
5  3  9  2 
5393 
5399 
5  3  9  5 

5396 

5397 
5399 
5399 

5390 
S3  9  1 

5392 

5393 
6399 
5395 
6396 
5397 
5399 
5399 


C  GRID  TO  BE  9 E 7 0 >1 E 0  IN  ¥  DIkECTIqN. 


190  NJMAX 1 «H JMAX* I 

C  REDEFINE  THE  V  COORDINATES  OF  THE  TRACERS, 


00  2211  N=1  .  M  V  0  I  D 
NPaNHPINl 

lFIMP.LE.nl  GO  TO  220 
00  210  M= l ,MP 
1  = 1NT ( TY 1 N , K)  ) 

IF  I  |  •  u T .JmAX •  AND  • ) V  A  PD 7  *  CQ • I  I  GO  TO  200 

TY I N,n I  * «5«TY  r  M,M  )  1 

GO  TO  2  l  0 

200  T¥M»TYIN*H)-ri.OATI  I  ) 

J  *  !  -  2  •  C  I  /  2  I 
L  = I  - J+ 1 

TY(lM,Mt  =  .5»FL0ATIl-j)*(T¥M«0Y(l  +  ll+FL0AT(J)*0»(lll/(0Y(CI*0T(L+ln 
2  10  CON  f I  HUE  ,  ■  j 

220  CONTINUE  '  ■  ! 

HR* (  1  MAX/2* 1  > * ( JMAX/2+ l  I  i 

DO  222  M=l  •  N P 

I  =  I  NT ( TP  I  9  »  1 

IFll.LT. JMAX  .AND.  lVANOY.eQ.il  GO  TO  221 
V  P  (  M  I  =  ,  5  *  T  P  (  H  1 
GO  TO  222 

221  YPM-YPlM>-FLOAT  1  I  1 

J= I -2  =  (  |  /2 I  i 

L*  I  “J*  1  !  ■ 

YPlMla  .5»FL06T(I“jl+(rPM»0T(l*l ) +FLOAT ( J) »DY (!)1/<0Y(L>«-DYCl  +  1>> 

222  COtlTltlUF. 

C  •  •  •  •  «  •  •  *•••••«••••••••••••  »•  ••••••• 

C  STONF  CELL  PH0PF.RTlr6  AT  TOP  EDGE  OF  OLD  GRID  SO  THaT  THEY 

C  CAN  F)F  USED  FOR  FILLING  IN  THE  NEW  AREA. 

c  «  . . . . . . 

DO  225  1*1  ,  [Max 
MFgREZ 1  1  I =0 
REZAMXl  I  1=0'. 

225  REZA 1 X 1  I ) =0. 

DO  290  I  =  1  ,  I MA  X 

K  =  < JMAX- 1  I • I  MAX, | ♦ 1 

MFKaMFLAGlK) 

MFGREZ (  I  I =MFK 

1  F  1  flFr.Lt.OlGO  TO  2'(fl 

REZAMXl  |  )  =  A  M  X  1  K  1  X  1 T  A  0 ( I ) «0Y I JrtAX  )  I 

IFCMFK.r,T.lOO)GO  TO  230  i; 

REZ  A  1  X  <  I  I  =  SS  1  FN  I  nr  K  )  ! 

60  TC  290  .  ; 

230  HFK.MFK-IOU 

DO  236  N  *  1  iNHAT  ; 

R  E  Z  X  M  S  I  N  »  1  I  s  .X  M  5 .6  1  6  , !  1 F  K  I  X  A  H  X  I  K  I 
RE2S1F.  I  M  .  1  1=0. 

I F  1 S I F ( M . HFK I  . GT . 0.  I  RE  ZS I E ( N .  I) =S5 | pN I N ) 

RF. /RHD  IN  ,  1  1  *»H0  (N  ,Mr  K  » 
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5400  235  REZAlxI  I  I-KEZAlXlIJtXMASSI  U,HFIC)*REZS!e<N,l  ) 

5401  REZAIX  |  I  l-HEZAH  I  i) /MIX  ( K » 

5402  REZRH01UV0I0»I)*RH0(NV0ID*NF’KI 

5403  240  CONTINUE 

isn't  c  •  •  •  »•••••••••••••••.  •  •  **••••*••••• 

5405  C  COMPRfS  twE  OLD  G»ID  JN  Y  DIRECTION  BY  COMBINING  PAIRS  Op  CEM.S. 

5404  C  l  ••  *  *  •  •••*••»•♦••«  •  *  •  •*••*•••••*** 

5407  00  250  J*  l i N JMAX 

5408  DO  250  1*1  ,  IMaX 

5409  K« I J» 1  1  *  I MAX  *1*  I 

5410  L*2* < J- J) • I MA X* I * I 

54  I  1  M  =  L*  IMAX 

5412  CAUL  COmPRS(L) 

5413  250  CONTINUE 

5414  C  •  •  •  •••*•••  .«  4. 

5415  C  REOEEINL  Y  AND  0 y . 

5  4  16  C** 

5417  DO  260  JM.NJMAX 

54  18  240  Y I J>  *Y ( ?• J)  , 

54  19  00.  270  J  =  N JMAX  1  .JMAX 

5420  270  T( J»«2«Y(J-I I-YIJ-2) 

5421  DO  280  J.=  l  i  JMAX 

5422  200  DY  (  J  I  =Y  (  J) -Y  (  J- 1  > 

5423  C*  ••*•«••••••*•••  •**••*•••••••••••• 

5424  C  FILL.  THE  N E 4  AREA  HtTH  THE  PROPERTIES  SAVED  ABOVE. 

5425  C  •  •  •  • 

5426  M0  =  0 

5427  CYC=0. 

6428  DO  300  J*l  .  IMa.X 

5429  DO  3  00  J*U JMAX t  . JMAX 

6430  K- < J-l  I ■  I  MAX* 1* 1 

5431  ■  MFl.AGIK  )  =MEfiREZ  I!) 

5432  AMX  I  K  1  *  R  E  /.  A  M  X  (  I  1  •  f  A  U  I  I  1*DY<JI 

5433  A  I  X ( K  >  =  I<E  Z  A  I  X (  I  ) 

6434  IJ  I  K  I  =U  . 

54  35  V  IK  1*0. 

64J4  I  E  <  ME  1.  Ar,  I  K  »  .I.T  .  1  00  I  GO  TO  300 

5437  CALL  Ml'AM  I  » 

6438  MEK*Mf  L AG ( K ) - I  00 

5439  DO  290  II*  I  .  NIiAT 

6440  KHO < N , NEK < =KI ZHHO < N , I >  * 

544  1  S I E 1 N , M F K  >  =  R E 7 S 1 1 ( N  i  1  I 

5442  2*0  XMASS  <  N  ,tlEE  )  =PI.Z*MS  (  N  ,  I  )  •  ACX  (K  » 

644  3  RMO  (  N  V  0  I  0  t  ME  K  )  =  f!LZ  R  MO  t  NV  0  I  0  ,  l  I 

5444  100  CONTINUE 

6448  *,»••••*' 

644*  c  UPDATE  the  total  THEOKITICaL  ENERGY  and  ACTIVE  ,-GKIO  COUNTER* 

5SS7 

54  4  8  DO  310  I  *  I  I  I  IT  A  x 

644*  no  310  J=NJMAX 1  ,  JMAX 

6460  r*<  j-i i *  hiax*  r  +  i 

6461  3  1  U  ETH*ETH*AIIX  I  ¥  )  •  A  1  X  (  Y-  I 

6«62  12=12/2 

6  4  6  3  N  6  =  N  6 / 2 
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S  **  &  H 

c  • 

S4SS 

t 

REzONt  HAS  FIMISHtD. 

| 

S4SA  - 

c  • 

S4S7 

RE  TURN 

SM&fl 

END 

, 

S4S9 

SUBROUTINE  51  TUP 

S  «  A  0 

c 

•  S  f  TUP  DEFINES  CELL  diUAF'T  j  T  !ES  AT 

T  JME«0  ,  ALSO  MATERIAL 

\ 

c 

TRACERS  APF  fcthfKATED  HERE  AS  t*EH  AS  Th f  PX»OY»X#Y* 

S4A2 

c 

TA.U  AND  MfLAG  ARRAY5. 

S  4  A  3 

( 

! 

5  4  A  4 

c 

•  THIS  PNOfiLt  M  C-E.HERATOR  CAN  SET  UP  ONE  SPHERE 

S4  AS 

c 

At'D  ANY  NUMBER  Of 

CYL  lA'DtRS.THE 

NUMBER  of  MATERIAL 

S4  AA 

c 

PACKAGES  IS  LIMITED  ONLY  p  Y  THE 

DIMENSIONS  Of  THE 

S  4  A  7 

t 

MIXED  CEl L  ARRAYS 

• 

| 

S  4  A  8 

r 

!  ’ 

S4  A9 

r 

•  ••  SETUP  r.R|TES  THE 

CYCLE  Q.  DUMP  ON  THE  RESTART  TAPE. 

S  4  7  0 

c 

S4  /  l 

INCLUDE  CPMDIP 

S  4  7  2 

1)1  MENS  1  ON  MX'AME  (  ‘ID  » 

DM  7  3 

DIMENSION  XSTPT 1  a  1  .  VSTRT < A )  , 

XEND « A )  , VEND  1  A » 

, IPASSIA) , INCFSIA) 

S4  7  4 

D  1  Mf  MS  ION  NT  »  4  I  ,TE  HP  I 4> 

S  4  7  5 

OATA(MNaM{  IK),Kpl,*tt)76H 

Til ,  AHNGSTEN  ,  AH 

, AHCOPPER  , 

S47A 

I  AH  t  AH  fRCN.AH 

AL , AHUM  I  MUM , AH 

PER.AHVLLIUM, 

S  'i  7  7 

?  All  T  t  ,/ HT  am  IUM  ,  ah 

,ahnicxle,ah 

MOLY  ,  AHBCEMUM , 

SM7S 

3  AH  T , AHHOR 1 NM , AH 

,  AH  LEAD,  AH 

po.ahlymers. 

SH79 

4  All  G  ,  AMMAN  I  Tf  ,  AM 

an , AHDF.S Mf  ,  Ah 

AEi.AHT  TUFF, 

B4HU 

S  AM  UR, AMY  TUff.AH  OIL, AH  SHALE, Ah 

DO  ,  AHLOM I TL , 

S48  1 

A  AH  LIM,AI  tSrC'ME  ,Ah 

,  ahhal I t t  ,  Ah 

IDE*AHAL  OaSV 

S4  8  2 

DATA  1  HMaHF  1  *C  >  ,X  M  1  .  “2  1  /AH 

,  AH0A.SAI  T  / 

S4B3 

HIDY»3«|*I  l  S977 

S4R4 

CVCLE«0.0 

SmijS 

DT.C.O 

S4MA 

NVO  1  D«*NMA  T  *  I 

•  i 

S4P7 

►.'MAX*  1  MAX*  JMAX  +  1 

S4RP 

KMAXAtKKAX* l 

S489 

JMAX  A  «  JM  A  X ♦ J 

S  4  9  P 

1  Max A«  t MAX* I 

S49  1 

X  M  A  X  =  X  <  I  M  A  X  ) 

i 

S«92 

>  M  A  X  «  Y ( jMaX  1 

1 

S4V3 

I  | MAXk | HA  X •  2  *  •  N  U  N  R  F.  Z 

l 

S  4  9  4 

JJMaX*JHaX»2»»NOMRE7 

6  4  9  S 

If  (MX  1  3)  ,l.f  .-3.  )  00  TO  2SP 

1 

S49  A 

C 

INITIALIZE  PROPERTY  ARRAYS 

! 

S  4  9  7 

DO  10  K« 1  , X  M  A  X 

5  4  9  8 

A II X  (A  1  =fl. 

c;«S9 

A  I  X  1  K  )  =  0  • 

5  sou 

u  (  K  )  «n . 

, 

SSL  1 

V  (  K  I  r-o  , 

SSt2 

HFL  AM  K  >«C 

$  «.  0  3 

1 0  CONY  I MUE 

1  ■ 

s  s  n  m 

c 

: 

ssps 

00  l  |  L *  1  ,Mm>  CIS 

S  S  (■  6 

RHOU.tl  *- 1  • 

SS07 

1 1  CONTINUE 

SSOB 
550? 
5510 
6511 
55  1? 
5513 
55  19 
55  1  5 
55  1  6 
5517 
55  1  » 
55  1  ? 

5520 

5521 

5522 

5523 
552*1 
5575 

5525 
5527 

5526 
5529 
55  30 
553  1 

5532 

5533 
5535 

5535 

5536 

5537 
5535 

5539 
5550 
5591 
6592 

5593 
6599 
5595 

5594 
559  7 
5598 
559? 

5550 

5551 

5552 

5553 
5559 
5555 

5554 

5557 

5558 
5  559 

5540 
55  4  1 


C 

DO  14  M ■ 1  ,  N  V  0  J  U 
DO  12  L* 1  •NMXcl .5 
FRACTPlM ,L  >»0. 

FHACRT(H,LI-0. 

|2  COII T  1  OUt 

DO  19  L *  l  .  N  T  P  M  X 
T  X  (  M  ,  L  I  *  0 . 

TY(H,L)*0. 

19  C  0 1 1 T I N  U  E 
14  CONTINUE 

C  COMPUTE  Y  values  FROM  OY  ARRAY,  . 

IFIlVARpY.EO.pl  60  TO  220 
C  p7  VARIES 

J*0 

203  READI5.5CH)  IHTIU)  »L*1  .9)  ,  CTEMp(L)  ,l"l  ,91 
DO  205  L=  1  t  9 
N  T  L  ■  H  T  (  L  1 

1  F  I  NTL  .EU.999  1  GO  To  Z04 

(JO  209  Ns  1  .NTL 

J»J+i 

0  Y  (  J  1  b  T  E  M 1’  1  L  1 

209  COtlTINUf 

205  CONTINUE 
GO  TO  203 

206  |F(J-JMaX)207, 209.207 

207  Y;RITE(A.2Gfl| 

20a  format ( &om 1  setup  c«ror  -  defining  more  or  less  than  jmax  dysi 

CALL  EXIT  ' 

C 

209  COM r I NUE 

Y (  I  1 «DY (  1  1 
DO  210  J=2.JMaX 
Y  «  J  1  =  Y ( J-  I  1  +DY  I  J I 

210  CONTINUE 
GO  TO  29U 

C  •  ••  DY  CONSTANT 

220  CONTINUE 

DO  230  J» 1 . JMAX 
Yljl  «  DYF»FLOAT(JI 
D  Y  (  J  I  a  0  Y  F 
230  CONT 1 NUE 

C  COMPUTE  X  VALUES  FROM  Ox  ARRAY. 

290  |Ff  1VaR()X.EQ.01  60  TO  260 
C  •••  OX  VARIES 

f«0 

293  READ15.501)  (  NT  (  L  1  . 1.®  1  .9  1  .  (  TE  HP  (  L  1  ,  L  -  I  ,  9  1 

00  295  L a  1  |9 
nTl»NT l L  1 

IFInTL.EU.999  )  GO  TO  296 
OO  299  M“T.MTL 
1*1*1 

DXI 1 IbTEHPILI 
299  CONTINUE 
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5562 

5563 

~ 

295 

SS69 

296 

5S6S 

297 

5566 

5567 

298 

5568 

C 

5569 

5570 

5571 

5572 

299 

5573 

5579 

250 

5575 

c 

5576 

5577 

260 

5578 

5579 

5580 

270 

550  1 

c 

5502 

c 

5583 

5588 
5535 

5586 

5587 
5508 

5589 

5590 

280 

5591 

290 

5592 

5593 
5599 
5595 

559* 

c 

5597 

c 

5598 

5599 

5600 

c 

5601 

5602 

950 

5603 

295 

5609 

5605 

955 

S6O6 

c 

5607 

296 

5608 

c 

5609 

c 

56  1  0 

c 

56  1  1 

c 

56  12 

c 

5613  . 

c 

56  l  9 

c 

56  1  5 

c 

CONTINUE 
GO  TO  293 

1F<  1-IMaX>297, 2*9,297 
A  R  I  r  E  (  6 , 2  4  8  | 

rOK-IATISOHlSETUP  ERROR  -  DEFINING  mORE  OR  LESS  THAN  IMAA  OxSI 
CALL  EXIT 

CONTINUE 
XI  I  l«=OX(  1  ) 

DO  2  SO  1*2,  I H  A  X 

xt i )»x« i  —  i »*nx«  1 1 

CONTINUE 
GO  TO  280 

•*«  OX  CONSTANT 
CONTINUE 
00  270  I  3  I  .  I  rlA  X 
X ( I)  «  0Xf»FC0AT  (  I  » 

Mill  »  DXF 
CONTINUE 

compute  cell  face  area  itadiiii  i 

ws»x  i  n  **  2 

T AU  (  1) ■ P I  0  Y • n S 

IF [ IGM.CO. IITAUI  |  )»0X ( |) 

DO  290  I -2 i (MAX 
PS A«  X (  |  | • 2 

TAUI  1  )  =  PlDY»fv*SA-NS  J  1 

IF  (  I  Gil  ,  £3  •  I  I  TAU<  I  )"0X(  I  I 

PSVAISA 

CONTINUE 

fo*i  ./flOaTintracR»  -';■■■ 

MO*  1 

M  B8  0  =0 
MBB  =  5 


•••  BEGIN  LOOP  ON  MATERIAL  PACKAGES 

00  50  NN=l iNHaT 
RE  AD ( 5,950 I  IGEOM 
FORMAT  111 > 

IF(IGEOM-I)  295,296,30 
Y/RITEI6.955) 

FORMATION  SAo  INPUT  -  SEE  STATEMENT  NO.  295  IN  S£  T(|P  I 
CALL  EX  it 

•  ••  SETUP  A  KC CT  ANGLE 

M*NN 

MAT  I M I  »  C 00£  MATERIAL  NUMBER  FOR  MTw  PACKAGE. 

USED  TO  IDENTIFY  E.S.  CONSTANTS. 
if  a  package  is  divided  into  spatially 
I)  I  SC  ON  NEC  TED  SUBPACKAGES,  WEaD  IN  THREE  .CARDS 
FOR  EACH  SUBPACKaGF.  VITH  k  NF  G  A  T-l  V  E  V  A  LUE 
OF  MAT  FOR  EACH  EXCFPT  ThE  it  A  S 1 
MR  T  =  I  OF  RIGHT  COLUMN  OF  PACKAGE. 

MTP  =  J  OF  IC'P  R()V.  OF  PACKAGE.; 
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t 


J 

V' 

V-" 


6616 

c 

MLF  ■  1  OF  LEFT  COLUMN  OF  PACKAGE* 

5617 

c 

MRT  ■  J  OF, BOTTOM  ROW  OF  PACKAGE. 

56  18 

c 

UR  •  RADIAL  VELOCITY  OF  ALL  CELLS  IN  PACKAGE* 

5619 

c 

VA  ■  A K ! A L  VELOCITY  OF  ALL  CELLS  IN  PACKAGE* 

5620 

c 

PHOIM  *  •  INPUT  DENSITY  FOR  PACKAGE 

5621 

c 

SIEN  a  SPEC*  I  NT .  ENERGY  OF  ALL  CELLS  IN  PACKAGE* 

5622 

c 

5623 

READ IS.SOO) MAT (M> ,PacHT,PACTP,PACLF,PACBT,UR,VA,SIEn.RHOIN(M) , 

5629 

1  C  Z  E  R  0  |  M  1  ft  STKl(H),  STK2(.D,  STCZ1MI.  R  M  U  (  M  )  ,  A  H  u  M(  M  1 

5625 

CALL  LOCI JfPACRT.MRT, .5,0) 

5626 

CALL  LOC I J< P ArT» ,MTP , .5, 1 ) 

5627 

call  loci jipaclf.mlf , .S,D> 

5628 

CALL  lOcIJIPACBT  ,  MB.T  ft  •  S  ,  I  1 

5629 

1  F  ( MRT  .EQ  *0  )  N«T»  1 

5630 

tFIMTp.E«*0|M1P«! 

563  1 

IFIPACRT.LE.O. IMRT-0 

5632 

IF ( PACTP .LE.Oft 1 MTP»0 

5633 

MLF»MlF*1 

5639 

N8TaM0T* 1 

5635 

JP  K  5  *  U 

5636 

IF(MATIM) .LT.O) JPKSa| 

5637 

MAT(h)BAPSCPAT(**)) 

5638 

UUR ( M ) «UR 

5639 

VVa(M)*va 

5690 

SS I EN ( M ) *  S I EN 

5691 

AR 1 TE < 6 , 900 1 

5692 

MAi=*,AT(rt)»2-l 

5693 

M  A  2  *  M  A  1 ♦  1  ■ 

5699 

T.R  1  TE  I  6, 9  1  0  )  M , MN AHE 1 M A  1 l ,MN AME 1 MA2 ) » *«0 INI « 1  ,  S  IEN,t»R  t  V  A  ,MlF  »mRT 

5695 

1  MPT  ftHTFftCZEROIM) ,STKI I M 1 , STK2 ( M ) , STEZ  C M 1 , RMU ( M 1  , 

5696 

2  A  m  d  *1 1  ii  1 

5697 

L=NMP |M) 

56  9  8 

LSAVEsL*  1 

5699 

FMLF«FLOA T ( MLF-  1  ) 

5650 

fmbt»float  <  tier- 1  > 

5651 

FMRT  =  FLOAT  (flRT  » 

5652 

FMTP.FLOAT(MTP) 

S6S3 

c 

•**  HsMUMBER  of  TRACERS,  ALONG  BOTTOM  BOUNDARY  OF  PACKAGE, 

565  9 

IF ( MB  T • EO • 1 ) GO  TO  18  - 

5655 

N=(MRT-MLF+1 )*ntracr»i 

5656 

1F«MRT.E0.0)N«( 1 IMAX-MLF*I)»NTRACR*2 

5657 

DO  |7  KlC=lftN 

5658 

L“L  ♦  1 

5659 

TX ( M ,L ) aFMLF*FLOA r (<K-1 )«FD 

5660 

1  / 

TV (M,L )»PMDT 

566  1 

1  8 

I  F ( M R T • E Q • 0 ) GO  TO  2\ 

5662 

IF  (  H8  T  .  NE  .  1  )  GO  TO  1  9 

5  66  3 

L*L  ♦  l 

5669 

T  X ( M , L ) =F  MRT 

5665 

T Y | M ,L 1 «U . 

5666 

1  7 

N»  (  MTP-mBT*  1  ),«NTRaCR-  1 

5667 

IF  t  NtP.E'JftOlNal  JJMAX-MBT*  l  >*NTRACRftl 

5668 

DO  20  KK  a  |  ,  N 

566” 

L  =  L  ♦  1 
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S670 

TX  1  8  ,L  »«FmRt 

567  1 

20 

TYlM,L>»FMeT*FL0ATUKl*F0 

5672 

21 

IFtMTP.EQ.0lGO  TO  23 

5673 

N« ( MRT-MLF* 1 IaNTRACR*! 

5674 

IMMRT.EQ.OINsUtHAx-MLFM  »»NTRaCR+2 

5675 

DO  22  KK«  1  ,  v 

5676 

L«L*  1 

5677 

T*  1  0 ,L  t  oEMLF*FLO  .«  T  (  N-KK  1  »rD 

5  6  7  4 

22 

TY  I  M  ,L  1  =  FMTP 

5679 

23 

IF  (MLF.ES. 1  JGO  TO  25 

5  6  8  0 

<  OTP-mir*  1  »  •flTHACR 

568  l 

1F1MTP.E5.QI  Na  (  J  JHAX-M3T*  1  1 »UTR ACR*2 

5682 

DO  24  KK=I,M  i 

5681 

L  =  L  ♦  1  1 

5684 

TXIH,Ll=FMLF 

5685 

24 

T  Y  (  h  .L  1  aFHUT  +  FI.O  AT  (  M-KK  1  »F0 

5686 

25 

IF  IL.LT. NTPMXIGO  TO  26 

568  7 

6R|TE(6,670)I. 

5688 

CALL  exit 

5689 

26 

H  M  P  (  M  )  a  L 

5690 

IFIL.E0.0IG0  TO  28 

569  1 

L  “L  ♦  t 

5692 

NMP(l4>aL 

5691 

T  X  (  M  ,  L  1  =  T  X  1  M  ,  1.  S  A  V 1 1 

5694 

TT(M,L1  =  Ty(m,LSA(/E1  ' 

569S 

28 

HMRoHWT 

5696 

1  F ( MRT . G r . I  HA  X . OR .MR T . EQ • 0 1 MMRa J Ma*  ' 

5697 

M  M  T  a  M  T  P 

5698 

IF  I  MTp,  r,T.  JMAX  .OR.MTP.tO.O  J  MMT»J(UX 

5  6  9  9 

JFIMLF.Gf. JMAX.OR.HBT.GT. JHAXIGO  TO  29 

5700 

DO  27  I.MlF.IU'R  | 

5701 

DO  27  JaHBT ,  MMT 

5702 

K= 1 J- 1  >  •  1  MAX*  J  . 1 

5703 

AMx  (  K  |  aKHO  I1J1  M  >  *TAU  (  11  *0Y  1  J> 

5704 

A  1  X  (  K  1  =  S  I  k  N 

5705 

U(K1=U« 

5706 

VULVA 

5707 

27 

MFLAC,  (K»a« 

5708 

IF(MRT.N£.d.ANO.MRT.LT,|MAX,ANO.MTp,NE,0,AND.iMTp.LT.jMAXlGO 

5709 

C 

I 

57  10 

C. 

•  •  • 

package  extfmos  ueyond  origional  grid. 

57  11 

o 

•  •  • 

57  12 

c 

57  13 

29 

M  B  O  fl  B  8  H 

57  14 

M  a  5S  M  l\  ♦  l 

5715 

MPAC1M8)=S 

57  1  6 

MPaCK(Mb>=M 

57  17 

PACXIHB.ll =FMLF 

57  1« 

PACX 1  MB , 2 1 opOPT* 1  .E-4 

5  7  1  9 

PACT (H8 , l  •  =FM8T 

57  20 

P  A  C  Y  1  M  B  ,  3  1  a  F  >1  T  P 

572  1 

IF  (m4T  ,f;5.0  H’ACX  1  »B  ,2)  “FLOAT  (  1  IMAX*  1  ) 

5722 

IF(hTP.E}.0IPACY(hH,3)»FL0AT(JJMaX+1> 

5721 

IFImLF.GT  »l  •  P  A C  1  ( .IB  ,  1  1»PaCX(M8,|  )*l.E-4 
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572** 

SF-1. 

5725 

lFlM9T.t.t.JPK0J)Sr«-l, 

5726 

IFIMBT.qT.  1  1PACV  trtll,  1  ).P*CY(H8, 1  >*SF»  1  .F>9 

S727 

SF»|, 

57?  A 

IFIMTp.uF. JPROJISF"-! . 

5729 

PACYlMB, -IMPACT (rtft*3)»SF»l .E-9 

5730 

PACx  I  MB  •  3 1 “PAC t t MU .2 1 

5731 

P  A C  X  I  MB  ,  9  )  3  P  A C  X  I  M 0  »  I  1 

5732 

P  ACX  (  MB  ,5  >  3PAC  X  <  HfJ  ,  l  1 

5733 

PACYlMB,2l»PACF(M(J,  1  ) 

5739 

PACY IMB ,9 ) -PACY (MU. 31 

5735 

PACY  (MB  ,5)  =PACY(  Mil .  t  ) 

5736 

5737 

60  TO  99 

57  38 

•30 

CONT 1NUE 

5737 

C 

•  ••  SETUP  A  CHICLE 

5790 

N»NN 

57  9  1 

c 

1SPHMX  »  MUM b EP  OF  CELLS  FROM  CENTER  Of  SPHERE  TO 

5  7  9  2 

c 

ITS  RIGHT  EDGE » 

57  9  3 

c 

JRAOH  "  uumbcr  of  cells  from  center  of  sphere  to 

579  9 

c 

its  bottom  edge. 

5795 

c 

JR  A  0  A  ■  NUMUER  OF  CELLS  FROM  CENTER  OF  SPHERE  TO 

5796 

c 

ITS  TOP  EDGE. 

5797 

c 

jSPHTP  =  MUMHER  OF  CELLS  FROM  BOTTOM  OF  r,RJD  TO  TOP 

S  7  9  8 

c 

EOGE  OF  SPHERE  '( AT  THE  AXIS). 

5797 

c 

JSPHUT  a  NUMBER  OF  CELLS  FROM  BOTTOM  OF  GRID  10  AND 

5750 

c 

INCLUDING  BOTTOM  EDGE  OF  SPHERE  (AT  THE  AXIS) 

5751 

c 

J C F N T R  a  NUMBER  OF  TME  GRID  LINE  WHICH  COINCIDES  W|TH 

5752 

c 

SPHERE  center  at  the  axis. 

5753 

•  c 

YCFNTR  =  DISTANCE  Of  SPHERE  CENTER  FROM  GRID  BOTTOM  f 

5759 

c 

IN  CENTIMETERS. 

5755 

c 

RADIUS  ■  RADIUS  OF  SPHERE  -  IN  CENTIMETERS. 

5756 

REAOIS.eOO)MAT(U) ,Ur,VA,SII.N,RHO|N(N(  , CZEROIN) • S TK 1  (N)  i  S  T  K  2  <  N  I » 

5757 

STC-Z(N)  .RMUINl  .AMUMIME 

575« 

aoa 

FORnATI 

5757 

l)  R  =*  0  , 

S  7  60 

UUR  (  N  |  aO* 

576  1 

V  V  A  I  N  )  a  1/  A 

5762 

SS  I  EN  (  N  1  *S  I  EN  ... 

5763 

MA 1 *NaT (N ) *2-1 

5769 

MA2»M*1*I 

5765 

YCENTRayl JCEHTRI  . 

5766 

AH  I  TE ( 6 , 92U | 

57*7 

*'•  R  1  T  E  I  6 , 9  ,V3  1  N.  HNANfIMA  1  )  t  TNAME  IMA?)  .RH0ININ1  ,SlEN  »I)R  |VA  ,RAD  IUS  « 

5769 

rcENTR.CZEROIN)  ,STK1 CM* .STK2INI  .STEZIHI ,RMUUH  .AMDNIN) 

576? 

DO  SI  I  S  P  H  *1 X  a  l  ,  [MAX 

57  70 

IFIRAOlUS.LE.Xl ISPHMX I 1  GO  TO  52 

577  1 

5  l 

CONTINUE 

5772 

52 

Y  T  0  P  a  Y  C  E  N  T  R  +  R  A  :’1 1  U  3 

57  73 

00  S 1  J  S  P  H I P  a |  , UMAX 

5779 

IFIYTOP.LE.YI JSPHTP) IGO  TO  59 

5775 

53 

CONI INUE 

5776 

59 

YBOTaYCENTR-RAO IUS 

5777 

I F ( Y90T.LT  «0«  lYBOTao, 
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57  78 

00  55  JSPH8T-I ,  JrtAX 

5779 

1F1 Y30T .LE • Y 1 JSPrtBT » ) 50  TO  56 

5  7  30 

55 

CONTINUE 

•1= 

5731 

56 

YC2«YCEur<?»«2 

5732 

RSGRO  a  8A0I'(S*»2 

5733 

00  98  1 ® 1 » | SPH9X 

5  7  8  9 

K  = < JSPMOT- 1  )  *  1 MA X » 1 ♦ l  ; 

■v 

5735 

XL2  a 1 X 1 1-1 > 1 *»2 

5736 

XH  2  »  1  X  (  1  )  1  •  »2 

vV 

5737 

00  96  J3JSPHHT , JS«HTP 

5799 

VOUSPH  a  T  A'J<  1  1  «0Y  <  Jt 

5799 

IF|  J.GT.  JCEnTRI  <30  TO  32  1  1 

5790 

ASYaYceNTfl-YtJ)  1 

5  7  9  1 

A5YP  =  TCEN  TP- Y ( J-  1  1 

5792 

50  TO  39 

5793 

32 

nSYaY | J- 1 ) -YCFNfR  ' 

5799 

ASYp.yl J1-YCENT9  i 

5795 

39 

W  S  8  *  X  l 2  *  A  S  Y  •  •  2 

5796 

A  S  A  a  X  8  2  ♦  H  5  Y  P  •  •  2 

S  797 

IFIASR. &E. 95383)  GO  T096 

5798 

IFI.VSa.LT. 9SQR31  60  To  95 

5779 

C 

•••  CELL  CUT  8 Y  SPHERE  BOUNoART 

5800 

XL2T«AMA*1  1  XL2i9SiR>-3)SYP««2) 

590  1 

XR2B  =  A«|N1  <  XR7 .9S0;»0-9SY»*2) 

5  8,0  2 

*SLF«XL2*'VSYP*»2 

58(13 

RECTA  0  =  0* 

5809 

HECTOl-O.  1 

5805 

1  F I  1 GM . f 3 . 1  ) GO  TO  93 

5806 

IF  l  6SI.F.L  T.RSOHDI  »CC  T  AO“P  1  D  Y  •  C  <  HSqRO-#S  YP*a  2  J -XL  2  )  •  WS  YP 

5907 

|F(A5Y.gT.'J.1  RECTOLaP  1  0Y«  1  XR2U-XL2  1  ♦  VSY 

5908 

•tSAaS'jR  T  (  1  PSORO-X',123  1  *93  )  »2.  /  3. 

5909 

ftSSaS'JR  T  (  1  RSQRQ-XL2T  1  »»3  1  *2./3.  j 

58  1  0 

60  TO  9  1 

58  11 

90 

I  K  (  YSI.F  ,L  T  .HSOS  J  1  RECTaO»«S  YP»  1  SORT  l R SORO-WS YP •  •  2  1  -SORT  (*L2  1  > 

58  1  2 

1  F  t  ASY.G  r  .0.  iRECTOLa.VSYa  (  S  »RT<  XR2fl*»S0RT  <  XL 21  ) 

58  1  3 

ASAa.ra»  (  $3.rt  (  XL2T  )  «50RT  <RS  JK0-XL2T  1  ♦RSjROaASINI  SORT  (  XL2TJ 

58  19 

1  /  R  A  0  I  (J  S  1  1  /  P  I  D  Y 

S8  1  5 

»S,ia  ,5»  (  S3RT<  XR2R  1  aSOPT  (R5  1«0-<R2b  »+RS^RO»ASl  N  1  SORT  (  XR201 

59  16 

1/RAOIUSl  ) / P I 0  Y 

58  17 

9  1 

CONTINUE 

58  1  8 

VOLSPHaP  IOY.  (  wSr-aSA  ) -RECTOL  +  REC  T’AO 

5919 

92 

RFUAGI < 1 = TO* 103 

5920 

,1F  1M0.UE  .N  IXCL?)  GO  T.)  93 

582  1 

A’R  1  T  £  (  6,553  1  1  ,  J  ,  1  GE09 

5822 

CALL  E  X  1  T 

5923 

93 

M  -  91) 

5829 

PHOC  1  ,H  1  *!).  ’ 

5925 

MO  a  nl)  t  | 

5326 

SIEIN.M)  .  5lri 

5  32  7 

V  C  <  1  =.  y  ft 

X' 

5928 

U  (  <  1  a  1 1  9 

r 

5329 

XHA5S(«,9)  >  VQ|.5PH.RH01H(9| 

5830 

EHOIN.M)  s  RlinlNIHl  ; 

5  9  3  1 

IMj.KoI.I)  f,  0  TO  9  9 

■s  T 

110 


5832 

* s«r*(/{  r  t*Dri  j> 

5833 

XMASSlN.l  ,M)«C6S-V0l.SPri)»HH0|N(N-l  | 

5839 

SlEIN-1  ,M)«AlXm 

5835 

IF t  XMASS<N-1 , M 1. L  T . 0  . )  Si  el  N-1 ,M1«0, 

5836 

IFIXHASSIN-1 ,M) . LT.0.|XHASS(N-1 ,M)*0* 

5837 

RHOIN-I ,H)«RH0I»(M-1 1 

5838 

*S«XMaS5IN.M»*XMASS(H-1 ,MI 

583* 

AlX(K)«(XMA5S(N-l ,8)*S1E(N-1  ,M)  ♦  S 1 EN « X M ASS  1 N • 

M  )  T/»S 

5880 

A  H  X  (  K  )  =  A'  5 

588  1 

GO  70  06 

5882 

C 

•  ••  SPHERE  BOUNDARY  IS  A  FREE  SURFACE  WHEN  SPHERE  IS 

5983 

c 

FIRST  PACKAGE  GENERATED  (N«l), 

5988 

0  8 

RHO ( NVO | 0 ,  M ) = 1 .0 

5886 

AMXIKl»XHASStN»H> 

5386 

AIX(K)=S!FN 

5887 

GO  TO  06 

5988 

c 

CELL  NOT  CUT  BY  SPHERE  BOUNDARY. 

5999 

85 

AMXIO.e  V0LSPM»PH0JNCM», 

5950 

V  1  K )  »  V  A 

585  1 

U(K)=UR 

58S2 

A  1  X ( K )  s  5 1 EN 

5853 

MELAG(K)=N 

5898 

c 

•  •*EMQ  Of  loop  ON  Rp'AStJ) 

5855 

8  6 

K  »  K  ♦  1  H  A.X 

5856 

c 

••«ENO  OF  LOOP  ON  COLUMNS! 1> 

S857 

08 

CONT 1 NUE 

5858 

c 

•••  place  particles  around  sphere 

5859 

JO  I A*  = JSFHTP*! -JSPH9T 

5860 

, 

10 | AM«2» ISPhMX 

5861 

A.NGLEsP  I  Oy/2.*AS  1  N<  I  YCENTH-YBOT  1  /RAOlUSl 

5862 

NCF.LLS*.75»FLOAT|MAX0C  J(*l  AM,  101  AH|  |  • ANGLE/P  I 0 Y 

59  6  3. 

KM  I  0=  NT  RAC«»  Nr  ELI.  S*1 

5868 

K  E  N  D  *  2  *  K  N  I  U 

5865 

NMP  (  HI  =KEi4i> 

5866 

AN«jLE»AN6LE/F|  OAT  IKENO-I  > 

5367 

DO  57  1  =  1  ,KE.WO  ,  ,  . 

5868 

T  X  <  N  ,  I  )3HaO|US»S!N(FLOATIKEND-1 ) •ANGLE! 

5369 

c 

»«•  tracer  coordinates  initially  DEFINED 

IN  fM-  UNITS 

5870 

57 

T  Y ( u  ,  1 ) oYCENTR*RA0 I U$*COS (FLOAT (KEN0-1J •ANGLE) 

587  1 

TX ( N , KENO I =0 . 

58  72 

IF  (YfioT  •  L  E  » (J  .  1  T  Y  !  M  ,  1  1=0. 

5873 

IFIYBOT.GT.Q.)  T  X  <  H  ,  1  1 ■ 0 .  .  ; 

5878 

NAaN-1 

5875 

1FIN.FQ. 1 )NA=NVOIO 

5876 

00  63  NP= 1 ,kem» 

5877 

00  58  1  =  1  ,  ISP MMX 

5878 

I F ( T X ( N , NP )  .  LF  •  X (  I  )  ) GO  TO  59 

59  79 

58 

CONTINUE 

5830 

59 

00  61  J=  1  ,  .IS  I’N  T  P 

588  1 

IF  l  T  Y  (  N  ,NP  )  ,|.e  •  Y  (  J  1  >G0  TO  62 

5  8  92 

6  1 

CONT  1.  n  U 1. 

5803 

62 

N  P  A  =  N  MP  (  N  A  >  ♦)"  T  N  !>*  |  -  H  P 

5  8  9  8 

c 

...  TKaCLP  COOED J NATES  COMVfRTF0  To  cell 

UNITS. 

5885 

TXIN,NP)=FLOAT(I-l>+<TKlN,NP)-X(I-I)l/0Xln 

Ill 


5  8  8  A 

TY!N,HP)«FL0AT( J-l >*<TYIU»NP)-Y< J-J  > I/DYI J)  l 

6887 

C 

...  N A  IS  PACKAGE  NUMBER  OF  MATERIAL  OUTSIDE  THE  SPHERE. 

58H8 

c 

MPA  15  lUOF*  FOR  TRACERS  OF  PACKAGE  NA  KHlCH  WILL 

5888 

c 

OE  ORDERED  EXACTLY  OPPOStTC  FROM  TllE  PACKAGE  N 

6880 

c 

TRACERS  IM  THIS  REGION. 

5891 

TX < NA ,NPA 1 "T X t N , NP 1 

5892 

63 

YYINA,NPA>"TY!N.NP> 

6893 

NPbMMP ( H 1  *  1 

68  9  9 

NMP(N)«nP 

5895 

TXlM,NP)»TXIN,l> 

6  P  9  A 

TYtN,MP)«rYUi,l  ) 

5897 

NPAbNmP 1 NA 1 ♦ I 

5898 

npb=npa+kfno 

5899 

NMPIMAIbNPU 

S9nn 

TX|NA,NPBI«TX(NA,NPA>  j  , 

5901 

TY tNA,hPb)«TY(WA,NPA»  j 

5  902 

I  F  1  HMP 1 NA > .LE .PTPHX > GO  30  99 

5  9  0  3 

»RITE<A,670)NA 

S909 

A  7  0 

FORMAT!*  ERROR  IN  SETUP.  NMP!,,!2.»)  GT  NTPMX . *  I 

S  9  0  5 

CALL  EXIT 

5  9  P  A 

c 

5907 

99 

CONTINUE 

59P8 

c 

5909 

c 

•  ••  jpr s=  1  Y'HEH  PACKAGE  we  have  GENERATED  IS  A  SUBPaCKaGE 

5910 

c 

AMD  THERE  IS  ANOTHER  SUBPACKAGE  T 0  BE  DEFINED. 

59  11 

IF ( JPKS.EQ. 1)00  TO  7  9  A 

59  12 

c 

•  ••  END  OF  LOOP  ON  MATERIAL.  PACKAGES.  , 

59  1  3 

50 

CONTINUE  j 

59  19 

c 

59  15 

c 

•  ••  0EF1NE  VOID  MATERIAL  TRaCF.RS  THAT  DEFINE  STRAIGHT  Ll'Nr 

59  1  A 

c 

BOUNDARIES  OF  THE  free  surface,  tracers  should  be 

59  1  7 

c 

ORDERED  SUCH  THaT  IN  TRAVELLING  BETWEEN  anY 

59  1  8 

c 

COMSECUTlVF  pair  of  TRACERS  THE  void  is  on  the  left. 

59  19 

IF ( N  S I D  E  S . E  Q . 0 ) G  0  TO  106 

5920 

l*nmpinvoioi 

592  1 

LSA VE=L* 1 

5922 

REAP  520  i  1  7.STRT  (  MM  1  ,  ystrt  <  PM  )  ,  kEND  (  MM  )  ,  YENDTMM  >  ,MH«  1  ,  nsi  OESJ 

5923 

520 

FORMAT  I 9E 1 0.9 | 

5929 

DO  7 1  MM= l  <  NS  IDES 

5925 

I  NCFS ( MM )  =  1 

592  A 

7  1 

|PKSSINN»»0  ‘  I 

5927 

1 P  K  S  S (  1  1  =  2 

5928 

INCFS  t 1 1=0  1 

5929 

I  F  1  NS  I  DES.Lt  .  1  1  CiD  Tr,  7  3 

5  9  30 

IPNSSl 11=1 

693  1 

DO  7  2  HM*2  ,NS  I  l)ES 

59  3  2 

I  F  (  APS  (  XSTKT  (  RM  1  -  XtND  1  MM-  1  1  !  .1.  fc.  .0  .  .  AN’P.  ABS  (  YSTRT  (  MM  >  -  TEND  (  MM-  1  )  > 

59  3  3 

|  . L E . 0 . 1 0 0  Tc  72 

5939 

1  P  K  3  S  C  M  M  1  =  l 

59  35 

I  F  i  XSTKT  1  MMI  .6T.0.  •  At  D.  YSTNT  (  Mm  >  .C,T.O.  )  1PKS5  (  Mfll  oO 

59  3  A 

1  NCI  S 1  MM  »  =  0 

593  7 

IF  ,  >  END!  MM-  1  1  .LE.tl.  . OR . Y EHt ( MM- |  )  .  1. E  .  0  .  )  1  PKSS  {  Mh- 1  >  «2 

S  9  3  8 

77 

COM  1  UU| 

59  3  9 

I  F  ly  I.i.iM  iS  I  !;l  6  i  .lL  .  f  •  .OR  .  Yl.NO  <  NS  1  DES  )  *Lfc  .0.  )  IPKSS  (  NS  I  [its  )  »2 
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5**0 

73 

CONTINUE 

S  9  H  1 

00  89  HM«|  ,  N  5  1  D  F.  S 

5982 

STRT  X«XS  TUI  HIM)' 

59  M3 

STRTY=YSTRT<MmI 

6988 

tNOX«XFhD  1  it M  1 

5  9  8  5 

£NOY*YtND <  flM  ) 

5  9  M  6 

1  NCF«  I  MCf'S  (  MM) 

5  9  M  7 

!PKS»1MKSS<mH) 

S9‘iH 

CALL  LOCI  J<STRTX,HSX',.5,0» 

59  H  9 

call  L0C1J<STRTY,I.Sy,.S.  1  1 

5950 

CALL  LOCI J(FNOX#NUX,.5»0) 

5951 

CALL  LOC  IJ < FNOY ,NUV , ,5, 11 

5952 

1F(STHTX.6C.0.  IC.O  To  152' 

5953 

NSXaO 

595M 

NSYaNSY* 1 

5955 

riuxafiox  +  i 

5956 

N  D  Y  •  N  0  Y  ♦  1 

5957 

GO  TO  166 

5958 

152 

IF  1 STRTY.GE.O. IGO  To  158 

5959 

NSY«0 

5960 

hoy«noy*  i 

596  1 

GO  TO  166 

5962 

158 

IF  (ENi)X.GE»0. IGO  TO  15o 

5963 

KSXxr4  5X  +  1 

5  9  6  8 

NO  X  »0 

5965 

GO  TO  166 

5966 

156 

IF |ENOr.GE«C. 150  TO  153 

5967 

NSXsNSX+t 

5968 

NOX^NOX+I  ' ■  '  ' 

5969 

NSY=N5Ym 1 

5970 

NCYaO 

597  1 

GO  TO  166 

5972 

158 

IF  1*851 STRTX-FNOX 1 .LE»OIOO 

6973 

lF(NSY,E'i«OlNSY»l 

5978 

IF  {LDY.E‘5»0)N0Y»l  ’ 

5975 

I  F  ( STHTX . ST .ENOX ) GO  TO  160 

5976 

!F(NOX.E<J.O)NOX*1 

5977 

NSXaHSX* 1 . 

5979 

GO  TO  166 

5979 

1  60 

IF (NSX.ES.OINSX*! 

5990 

N5 Y  =  ns  Y  + 1 

599  1 

NLi  Y  =  NI)  Y  +  1 

5982 

NOXaNDX* 1 

5933 

GO  TO  1  66  ... 

5938 

162 

1  F  ( (vSx  «F}.  O')  NS  X«  1 

59  8S 

lF(NOX.FU«0)Nr)X*l 

5996 

IF  (STRTy«GT.EM'JY)GO  TO  168 

6987 

If  1 ND Y • £  * • 0 ) NO  Y  « 1 

59  8  8 

NSXsMSX* 1 

5999 

N  0  X  *  M  0  A  ♦  1 

6990 

N  5  Y  =  F;  S  Y  ♦  1 

5591 

GO  TO  166 

5992 

168 

IF  <  NSY  .  Flw  .  0  1  NSY  »  t 

5993 

H  r>  Y  =  ,\  0  Y  +  1 

113 


■  i 


599** 

1  66 

!F(NDX.f.Gl.NSX,0R.NDY.EQ.N5Y|G0  TO  |  70 

5995 

1  TE ( 6 , 168 ) MM , NSX ,NSY ,NOX ,NDt 

5996 

I  69 

FORMAT (22H  CRROR  IN  FREE  SURFACE  .SXiSIAli 

5997 

call  exit 

5999 

1  70 

CONTINUE 

5999 

in  IPKS.EQ.l )L5AVE«L+I 

6000 

IF f ABS 1 STRTX-ENOX 1 «LE .0 > 1  GO  TO  99 

600  1 

IF (NSX.EW.O)GO  TO  82  i 

6002 

IF (NSX.gT.NDX.AN0.NDX.GT.01G0  TO  92  ■  !' 

6003 

C 

*  •  *  *). 

.  .  •  1 

6009 

c< 

• 

6005 

c 

■ 

6006 

N“(N0X-nSX*1)«MTRACR*1-IFCF 

6007 

IF (nOX.EG.O)Nb( 1 JMAX-NSX+1 )*NTRACR+2“INCF' 

6009 

0  0  6  1  K  K  » 1  •  N 

6009 

L°L+  1 

60  1  0 

TX(r:V0lDiLl»FL0AT(M5X-n+FL0AT(KK“16lNCFI*F0 

60  1  1 

8  1 

T Y ( NVO 10»L 1 *FLOA T ( NST 1 

60  1  2 

GO  TO  88 

6C1  3 

c 

60  1  9 

c « 

*  •  *  1 

6015 

c 

60  1  6 

92 

N«(NSX-nOX+I  i  «mtracp* i-incf 

60  17 

I  F ( NSX ,eS .0 1 N= (  t 1 MAX-NOX  + 1  ) »NTRACR*2 

60  l  9 

0  0  8  3  K  K  ■  1  1  M 

60  1  9 

L  *  L  ♦  1 

6020 

TX(nVOI0.L)*FLOAT(NDX-1|*FLOAT(N-KK)«FD 

60  2  1, 

93 

TY(NV0ID.L)»FL0AT(NSY-1) 

6022 

GO  TO  66 

6023 

8H 

if  inSy.eg*oigo  to  a<. 

6029 

IFINSY.gT.NcY.ANO.NqY.GT.OIGO  TO  96 

6  0  2  5 

c 

6026 

c« 

•  •  • 

6027 

c 

6029 

N= ( NDT-nSY* 1  1 »NTRACR+ 1  - r NCF 

60  29 

lFlNCT.EG.0lNa(JJMAX-NST»l)»NTRACR*2-|NCFl 

6030 

DOFSKKNIiN 

603  t 

L  *L  ♦  1 

6032 

TX  (f:  VOID,  L> -FLOAT  (NSX- l  1 

60  33 

85 

TY (NVO ID «L> "FLOAT (N5Y-I1+FL0AT (KK-1 +INCFI »F0 

6039 

GO  TO  68 

6035 

c 

6036 

c« 

•  •  *  4 

6037 

c 

6039 

86 

N“(NST-Nk)Y*|  1*NTRACR*1-INCF 

6039 

IF  1 NSY.E8. 0  I N» ( JJMAX-NDT*! ) *HTRACR*2 

6090 

DO  87  KK»1.N 

609  1 

L  "L  ♦  1 

6092 

TX  (  NVO  ID  »L  )  "FLiMT  (  NSX  1 

609  3 

87 

TY(NV0I0.L1=FL9ATINDY-1)*EL0AT(N-KK>*F0 

6  0  9.9 

flfl 

I  F  (  I  PK  5  •  NE  .  ?  1  r.il  TO  8  6 

6095 

L  *  L  ♦  1 

609  6 

T  X  (  N  V  0  1  D  .  L  1  =  T  X  (  N  V  0  I  0  ,  t.  S  A  V  E  1 

609  7 

TT(NV0I0,L)=TY(NV0ID,LSAVE1  i 
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6048 

6049 

6050 

6051 

6052 

6053 
6059 

6055 

6056 

6057 

6058 

6059 

6060 
6061 
6.0  6  2" 

6063 

6064 

6065 
6  06  6 
6  0  6  7 
6068 

6069 

6070 
607  1 
6072 
60  73 

6074 

6075 

6076 

6077 
60  78 
60  7  9 
6060 
6081 
6082 

6083 

6084 

6085 
606  6 
6  06  7 
6088 

6089 

6090 
609  1 
60  9  2 
6093 

60  94 

60  9  5 
6096 
60  9  7 
6098 
609  9 
6  l  00 
6  10  1 


L  SA  V  E*L ♦  I 
89  CONTINUE 

NHP(NVO!D)»L 
I F ( l »LE • NTPmX 1  GO  TO  10b 
rtRJ TE(6,630) 

630  FORMAT  <  •  ERROR  IN  SETUP.  NMP<NVOId>  GT  MTPMXM 
CALL  EXIT 
105  CONTINUE 

c  •••  mooLC  tracers  slightly  so  Package  boundaries 

C  OONT  PALL  EXACTLY  ON  Grid  LINES  AND  MIXED 

C  CELLS  CAM  BE  MORE  EASILY  DEFINED. 

C 

DO  1 20  N- l tttVOID 

NN=NMP  (  N  )’  . 

IF (NN. ED. 01  GO  TO  >20  . 

DO  1  10  L=1  iNN 

IF  {TX  (N,L»  .C,T.Q.  ,ANO.TX(N,U  .LT.FLOAT  (UMAX  |  1  TX«N,L)«rX(N,LY*I  .E-4 
SF  a  1  . 

IF  (  INT<TY(N,L)  I  .1  f. JPROJ)  SF«-1;. 

IF ( T Y I N  ,L 1 .GT.0. . ANO. TY t N.L ) .LT.FLOAT | JJMAX ) ) 

|  T  Y  I  N  ,  L  1  «TY  (  M  «L  )  ♦  1  .FI-*!  »SF 
1 l 0  CONT 1 NUE 
|20  CONTINUE 

C  ,  .  •„  l  ■■  .  ■■■  .  ■ 

C  FLAG  CELLS  BORDERING  P  AC*  AGES 

DO  ZOl  M»t . N  V  0  t  0  ,  . 

N  P  »  N  M  P  (  M  ) 

lElNP.Ea.OlGO  TO  201  ■  .  ; 

DO  200  L° 1 .NP 
I=1NT(TX(M,LI 1*1 
j«InT(Ty<m,l))*1 

IE (  I  .GT .  IMAX.OR, J.GT, JMAX >G0  To  20 n 
K= ( J-  1  I  «  l  max* 1  +  1 
MFK.MFL  «G  <  K  ). 

I  F  (  MFK  .GT  .  100  1  MA«flFK-100 
CALL  PRoPRT 

200  CONTI NUE 

201  CONT I NUF 

C  «•*  COMPUTE  TOTAL  ENERGY  IN  GRID  t.ETH » 

258  eTh*0.  :  .  ■ 

DO  300  KM.KHAX 

E  T  M*  E  T  H  ♦  AM  X ( K I • < • S« I U ( K ) * *2  *  V(K>**2>  ♦  A  I  X  C  K  7  > 

300  CONTINUE 

C  ::■■■■.  •  ,  -  '  ■  .  -  ,  •. 

.  IF  (VTCC.LV. 0)  GO  TO.  308  .  .  . 

c  «»«  setup  passive  cell-centered  tracers  *hen  ntcc.gt.o. 

np =o  - 

•DO-  30  3  1  =  l  .  IMAX  ,2  . 

00  303  J— l.JUAA.2 

K= (J- l)*l MAX* 1*1  , 

IF  I  AMX  (K  1  ,LE -C.  l  GO  TO  303 

M6MC  L  A.G.C K  1  . 

■  .  IF  CM.lt. ICO )  GO  TO  302 
M=M- ICO 
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0  2 
0  3 
M9 

ns 
06 
07 
06 
09 
1  0 
1  1 
12 
1  3 
19 
1  S 
1  6 

1  7 

ia 

19 

20 
21 
22 
23 
29 

25 

26 
27 

2  fl 

29 

30 

31 

32 

33 
39 

35 

36 

37 

38 

39 
•*0 
9  I 

92 

93 
99 
9  5 

96 

97 
99 
99 
50 
6  1 
52 
5  3 
59 
55 


30  I 

302 

303 

307 

308 


PV«0» 

DO  301  N"1,NMJ>T 

IF  (KHQ(MiM)  .  LE  <  0  > )  f,0  TO  301 

PV  =  PV*XMA5SII.,II1/RH0<N.M) 

continue 

IFIPV.LT*  (TA1I(  1  |  *0  Y  <  J)*.S)  )  GO  TO  303  1 

N  P  «  N  P  ♦  )  i 

X  P ( HP  1  o  FLOAT (  I 1-.5  I 

yp(HP)  o  r loat < j i - .5 

CONTINUE  I 

ntcc.np 

f.R  I  TE  <  6,307)  (L  ,  XPIl. )  ,  VpILI  .L«l  ,NTCC  I 

FORMAT  (  1  A  ,  "CELL  CENTERED  TR  ACEKS*  /(  1 5 , 2F  1 0 .2  ,i  1 5 , 2F  |  n  •  2  •  1  5 , 2F  I  0  •  2  . 
1  IS  >2F 10.2 , 15 i 2F 10.2)1 


continue 

•  »•  6  R I T  E 

WS=55S.O 
REWIND  KOMI  TV- 
WRITE  (KUH1TW) 

(  K  U  N  1  T  ».  ) 
l KUh ITW ) 

1  kUiiI  TV'  I 
1  KUll  I  TV) » 

(  K UN  UK  ) 


tape:  dump  for  ocle  o< 


« R  I  TE 

WRITE 

WR|  TE 
6R  1  T  F. 
WRl  TE 


350 


900 

9  1  0 

920 
9  30 


sro 

L  C  1 


A 5  »  CYCLE 
( 7 ( n i l.l .  iso i 

1 0  I  1  )  ,  V  (  |  I  ,  *MX  (  |  )  ,  4  j  X  I  J  1  ,  pin,  HFL«G<  M  <  !■>  iKNaXI 
I STrsZZ ( I  I »  STRSRPII),  5  T  R  S  P  2  (  I  1  .  l-l.KMAX) 

i  x  i  n  ,  t> x  1 1 1 ,  t  aoi  i ) ,  i«i ,  imax) 

(Till,  UT (11.  1.1 ,JMAX) 

W  R  1  T  E  (  A  U  N  I  T  »;  1  <  C  2  E  R  fl  (  M  I  ,  5  T  K  !  {  M  |  ,  ST  K  ?  (  M  I  ,  STEZ(M),  KKUtM), 

1  A  N  D  N  (  M  1  i  SSIEN(M),  00ft  (  M  I  ,  V  V  A  (  M  1  ,  MaTIMJ,  PLlMH}, 

2  Me  1  ,RMAT  ) 

6R  I  TE  (  aunt  TlV)  |  MPAC  (1  1  ,MP*CK  (I)  ,  1*1  ,MBpf>) 

A  R  I  T  F  |  A  U  H  I  T )  »  1PACXI  I  ,L)  .PACT!  |  ,LI  ,  1«1  .P6BBI  |L»1  ,HBB) 

A  R  |  T  E  (  X  U  N  I  T  f.‘ )  C|XMA55(M,L)  .  RHO(F.L).  5|E(M,L>.  S A HP Y ( M  ,  L )  , 

1  SARMPCM.Ll,  M»l  .miaT) ,  PHOINVCID.Ll  ,l«i  .nmxclsi 
DO  350  h  = I  iNVHI D 

N  P  *  N  M  P  (  N  I 

AKllEIXUMT’K)  HP  ,  1  T  X  (t:  ,L  1  il  T  tN  ,L  1  .L=l  .HP  ) 

CONTINUE 

NP*  I  1 X;  A  X  /?♦  |  )  *  (  JN  A X /  ■>♦  l  ) 

WRITE(KUNITW)  NP  ,  (XPILI  iTP(L)  » L  •  1  ,NP) 

6  S  »  6  A  A  •  0 

T‘ R  I  T E  (  K U P  1  T  0  1  ''  S',  f«S 
RETURR 

FOftMATI//  90X , 1 BhlNIT 1 AL  COND 1 T I 0N5 / / 1 2 X , 8 HM A T E R I  A L ,  ’ 

16X.7HDENSlTY.8X , 3 H S 1 f , I  | X  ,  I hU  ,  1 2 X , ) H V , 7 X , 7HL EF T ( l )  , 3 X  ,  0HR 1 uHT <  l ) 

2  3  X  ,  9MB0TT0P.I  J1  ,2X,6hTOP1  Jl/1 

EOftMATIVH  PACKAGE  . M  . 2 A6 , 1 X . 1 P9 E  l 3 . 5 , 3X , I  3 , 7 X , I 3 . 7X . T 3 . 7 X . 1 3 // 

1  29  X,  2HV0,  I  !X,7hY  1  ,  l  IX  ,2hY2, 1  l  X  ,  2  HE  C  ,  11:  X  ,  3hR  KU  ,  1  C  X  ,  9H  AMUR  / 

2  2  3  X ,  ] P6f  I  3  •  5 /  /  )  ■  f 

FORMAT  <//90x,  I  8H1NIT1AL  C.  C  N  0  I  T  I  0  M  S  /  /  1  2  X>8  H  M  A  T  E  R  1  A  L  ,6X  .7H0ENS1TT  • 
lBX,3HSIEil|X,l HU, 12X.1KV, 7*. 6 HR APIU5.9X, ftHCENTLR/) 

F  o  ft  i'  a  T  (  9  n  package  .  i  i  ,  2  a  <  ,  I  x  ,  e  i  3 . 5  , 2  F  I  n .  3  /  / 

1  29X,?HYC.l|;.,2HYl»)]r,2nY2,llXf2HE0,lCX,  3hRNU  >  IOX.MhAE'OM/ 

2  22X  ,  | P6E 1 3.5// ) 

FORMAT (  1  *  ,  9  p  1C.9/9E 1 0 . 9 / 6E 10,9) 

F  Oft  .i  AT  1.9  I  9  .  E  1  <•  .  9  ,  3!  1  ('  .  9  J 
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6)5  6 
6157 
61  5« 

6159 

6160 
6(61 
6)62 
6  163 
6169 

6165 

6166 
6167 
6166 
6  169 
6  170 
6  17  1 

6172 

6173 
6179 
6175 
6  1  76 
6177 
6  1  7# 
6  179 
6|60 
6161 
6  16  2 
6  163 
6  199 
6  1  65 
6166 
6  137 
6  16  6 
6  |  69 

6190 

6191 

6192 
6  193 

6199 
6195 
6  196 
6197 
6  (  98 
6  1  99 

6200 
6701 
6  2  0  2 
6  20  3 
6209 
6205 
6  20  6 


550  F0RMATU7H  ExCEFOfcO  STORAGE  RCGuEStEP  FOf (  MIXED  CE LL S » NM*CLS > *  I  1  • 
IJtlGCOM)  •  |  3  I  6  ) 

600  F0RHATI3l6,2F6.3) 

ENO 

SUbROUTjNE  STPNG 
INCLUDE  COMO  1 M 

c 

c  •  ••  STRNG  IS  CALLED  FROM  PH3  TO  COMPUTE  THE  YIELD  STRENGTH 

c  of  the  material  in  cell  k. 

900  streng»o. 

1F1HFK.gT.10C)  GO  to  905 
C  «•«  pure  cell 

N-HAT ( MTK 1 

SOL id-amdhi mfk) »RHOZ (N) 

OENSTY«aMX<K )/<TaU( I |.DY< 

IF IDEN5TY  «LT .SOLID)  GO  TO  990 
ASA-  1  . 

IF  (  A  t  X  (K  )  .LT.O.OR.  ApS(5TE2(MFKn  .Lr.0>«»0  TO  9  02 
Y.SA»l.-AlXm/STEZlMFK) 

I  F  1* S  A • L T  •  0 . 1  GO  TO  990 
80 2  *SB»DENSTY/RHOZ IN >~1 • 

STRENG=(CZER0(MFKl+ASF)*|STKl(MFK)+STK2lHFKl*WSB))*6SA 
60  TO  990 

C  •••MIXED  CELL 

90S  MKF-MfK-100 

1FIRH0 (NVOIO.MKF  )  .GT  .0.  )  GO  TO  990 
00  907  MM-'|  ,MMAT 

IF  1 XHaSSIMH tMKF ) .LE ,C. 1  GO  TO  907 
N-MAT  (MM) 

SOL IDsAMDMIMM) • RhOZ ( N ) 

IF(RH(HmM,HKF1 .LT.SOt ID)  GO  TO  990 

907  CONTINUE 

c 

vcell-taui n  «nT ( j) 

DO  909  M«- 1  I N M A  T 

IF(X.MaSS<MH,MKFI  .LE.O.  )  GO  TO  909 

ASA  -  1  . 

IF!  ABSISTEZIMMI  I. LE.O. I  GO  TO  908 
ASA- 1 ,-S 1 t (MM ,MKF ) /STEZ1HM) 

IFIbSA.LE.O. )  GO  TO  909 

908  N-MAT ( MM  I 

WSB»RhO(MM,MKF1/KHOZ(NI-1 . 

VOlM  -  xMA'iS  (  MM  ,MKF  !  /  1  NhO  (MM  ,MKF  I  •  vCELL  ) 

C  •*.  STRENGTH  OF  MATERIAL  IN  A  MIXED  CELL  IS  t  VOLUME 

C  'VEfSHTED  AVERAGE  OF  THE  STRENGTHS  OF  ALL  THE 

C  MATERIALS  IN  THE  CFLL. 

STEENS  -  STRING  *  VOLM*  (  CZERO  (HM  )  ♦•«S0*  (  STK  1  (  MM  ) +STK?  (  MH)  ♦»S6  )  )  »*>SA 

909  CONTINUE 
990  WS-STRENG 

RETURN 

ENO 


fi 

v 
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